File: rpc.clp

package info (click to toggle)
clips 6.21-6.2
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 7,956 kB
  • ctags: 8,731
  • sloc: ansic: 97,932; makefile: 1,406; sh: 189
file content (181 lines) | stat: -rw-r--r-- 4,863 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181

;;;======================================================
;;;   Rock, Paper, & Scissors Game
;;;     
;;;     Plays a children's game in which
;;;        Rock smashes scissors,
;;;        Scissors cut paper, and
;;;        Paper covers rock.
;;;     Demonstrates a use for the random
;;;     conflict resolution strategy.
;;;
;;;     CLIPS Version 6.0 Example
;;;
;;;     To execute, merely load, reset and run.
;;;======================================================

;;;****************
;;;* DEFFUNCTIONS *
;;;****************

(deffunction yes-or-no-p (?question)
  (bind ?x bogus)
  (while (and (neq ?x yes) (neq ?x y) (neq ?x no) (neq ?x n))
     (format t "%s(Yes or No) " ?question)
     (bind ?x (lowcase (sym-cat (read)))))
  (if (or (eq ?x yes) (eq ?x y)) then TRUE else FALSE))

;;;*************
;;;* TEMPLATES *
;;;*************

(deftemplate win-totals
  (slot human (type INTEGER) (default 0))
  (slot computer (type INTEGER) (default 0))
  (slot ties (type INTEGER) (default 0)))

(deftemplate results
   (slot winner (type SYMBOL) (allowed-symbols rock paper scissors))
   (slot loser (type SYMBOL) (allowed-symbols rock paper scissors))
   (slot why (type STRING)))

;;;*****************
;;;* INITIAL STATE *
;;;*****************

(deffacts information
  (results (winner rock) (loser scissors) (why "Rock smashes scissors"))
  (results (winner scissors) (loser paper) (why "Scissors cut paper"))
  (results (winner paper) (loser rock) (why "Paper covers rock"))
  (valid-answer rock r rock)
  (valid-answer paper p paper)
  (valid-answer scissors s scissors))

;;;****************
;;;* STARTUP RULE *
;;;****************

(defrule startup
  =>
  (printout t "Lets play a game!" crlf crlf)
  (printout t "You choose rock, paper, or scissors," crlf)
  (printout t "and I'll do the same." crlf crlf)
  (printout t "Rock smashes scissors!" crlf)
  (printout t "Paper covers rock!" crlf)
  (printout t "Scissors cut paper!" crlf crlf)
  (set-strategy random)
  (assert (win-totals))
  (assert (get-human-move)))

;;;********************
;;;* HUMAN MOVE RULES *
;;;********************

(defrule get-human-move
  (get-human-move)
  =>
  (printout t "Rock (R), Paper (P), or Scissors (S) ? ")
  (assert (human-choice (read))))

(defrule good-human-move
  ?f1 <- (human-choice ?choice)
  (valid-answer ?answer $? =(lowcase ?choice) $?)
  ?f2 <- (get-human-move)
  =>
  (retract ?f1 ?f2)
  (assert (human-choice ?answer))
  (assert (get-computer-move)))

(defrule bad-human-move
  ?f1 <- (human-choice ?choice)
  (not (valid-answer ?answer $? =(lowcase ?choice) $?))
  ?f2 <- (get-human-move)
  =>
  (retract ?f1 ?f2)
  (assert (get-human-move)))

;;;***********************
;;;* COMPUTER MOVE RULES *
;;;***********************

(defrule computer-picks-rock
   ?f1 <- (get-computer-move)
   =>
   (printout t "Computer chooses rock" crlf)
   (retract ?f1)
   (assert (computer-choice rock))
   (assert (determine-results)))

(defrule computer-picks-paper
   ?f1 <- (get-computer-move)
   =>
   (printout t "Computer chooses paper" crlf)
   (retract ?f1)
   (assert (computer-choice paper))
   (assert (determine-results)))

(defrule computer-picks-scissors
   ?f1 <- (get-computer-move)
   =>
   (printout t "Computer chooses scissors" crlf)
   (retract ?f1)
   (assert (computer-choice scissors))
   (assert (determine-results)))

(defrule computer-wins
  ?f1 <- (determine-results)
  ?f2 <- (computer-choice ?cc)
  ?f3 <- (human-choice ?hc)
  ?w <- (win-totals (computer ?cw))
  (results (winner ?cc) (loser ?hc) (why ?explanation))
  =>
  (retract ?f1 ?f2 ?f3)
  (modify ?w (computer (+ ?cw 1)))
  (format t "%s%n" ?explanation)
  (printout t "Computer wins!" t)
  (assert (determine-play-again)))

;;;***************************
;;;* WIN DETERMINATION RULES *
;;;***************************

(defrule human-wins
  ?f1 <- (determine-results)
  ?f2 <- (computer-choice ?cc)
  ?f3 <- (human-choice ?hc)
  ?w <- (win-totals (human ?hw))
  (results (winner ?hc) (loser ?cc) (why ?explanation))
  =>
  (retract ?f1 ?f2 ?f3)
  (modify ?w (human (+ ?hw 1)))
  (format t "%s%n" ?explanation)
  (printout t "You win!" t)
  (assert (determine-play-again)))

(defrule tie
  ?f1 <- (determine-results)
  ?f2 <- (computer-choice ?cc)
  ?f3 <- (human-choice ?cc)
  ?w <- (win-totals (ties ?nt))
  =>
  (retract ?f1 ?f2 ?f3)
  (modify ?w (ties (+ ?nt 1)))
  (printout t "We tie." t)
  (assert (determine-play-again)))

;;;*******************
;;;* PLAY AGAIN RULE *
;;;*******************

(defrule play-again
  ?f1 <- (determine-play-again)
  (win-totals (computer ?ct) (human ?ht) (ties ?tt))
  =>
  (retract ?f1)
  (assert (get-human-move))
  (if (not (yes-or-no-p "Play again? ")) 
     then 
     (printout t crlf "You won " ?ht " game(s)." t)
     (printout t "Computer won " ?ct " game(s)." t)
     (printout t "We tied " ?ct " game(s)." t t)
     (halt)))