summaryrefslogtreecommitdiff
path: root/ipl/progs/animal.icn
blob: 46497ef973633268555f916122780143d2b80e2c (plain)
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
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
############################################################################
#
#	File:     animal.icn
#
#	Subject:  Program to play "animal" guessing game
#
#	Author:   Robert J. Alexander
#
#	Date:     March 2, 1996
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#  
#     This is the familiar ``animal game'' written in Icon.  The
#  program asks its human opponent a series of questions in an attempt
#  to guess what animal he or she is thinking of.  It is an ``expert
#  system'' that starts out with limited knowledge, knowing only one
#  question, but gets smarter as it plays and learns from its opponents.
#  At the conclusion of a session, the program asks permission to
#  remember for future sessions that which it learned.  The saved file
#  is an editable text file, so typos entered during the heat of battle
#  can be corrected.
#  
#     The game is not limited to guessing only animals.  By simply
#  modifying the first two lines of procedure "main" a program can be
#  created that will happily build a knowledge base in other categories.
#  For example, the lines:
#  
#	   GameObject := "president"
#	   Tree := Question("Has he ever been known as Bonzo",
#	      "Reagan","Lincoln")
#  
#  can be substituted, the program works reasonably well, and could even
#  pass as educational.  The knowledge files will automatically be kept
#  separate, too.
#  
#     Typing "list" at any yes/no prompt will show an inventory of
#  animals known, and there are some other commands too (see procedure
#  Confirm).
#  
############################################################################

global GameObject,Tree,Learn
record Question(question,yes,no)

#
#  Main procedure.
#
procedure main()
   GameObject := "animal"
   Tree := Question("Does it live in water","goldfish","canary")
   Get()	 # Recall prior knowledge
   Game()	 # Play a game
   return
end

#
#  Game() -- Conducts a game.
#
procedure Game()
   while Confirm("Are you thinking of ",Article(GameObject)," ",GameObject) do
	 Ask(Tree)
   write("Thanks for a great game.")
   if \Learn &
	 Confirm("Want to save knowledge learned this session") then Save()
   return
end

#
#  Confirm() -- Handles yes/no questions and answers.
#
procedure Confirm(q[])
   local answer,s
   static ok
   initial {
      ok := table()
      every ok["y" | "yes" | "yeah" | "uh huh"] := "yes"
      every ok["n" | "no"  | "nope" | "uh uh" ] := "no"
      }
   while /answer do {
      every writes(!q)
      write("?")
      case s := read() | exit(1) of {
	 #
	 #  Commands recognized at a yes/no prompt.
	 #
	 "save": Save()
	 "get": Get()
	 "list": List()
	 "dump": Output(Tree)
	 default: {
	    (answer := \ok[map(s,&ucase,&lcase)]) |
		     write("This is a \"yes\" or \"no\" question.")
	    }
	 }
      }
   return answer == "yes"
end

#
#  Ask() -- Navigates through the barrage of questions leading to a
#  guess.
#
procedure Ask(node)
   local guess,question
   case type(node) of {
      "string": {
	 if not Confirm("It must be ",Article(node)," ",node,", right") then {
	    Learn := "yes"
	    write("What were you thinking of?")
	    guess := read() | exit(1)
	    write("What question would distinguish ",Article(guess)," ",
			guess," from ",Article(node)," ",node,"?")
	    question := read() | exit(1)
	    if question[-1] == "?" then question[-1] := ""
	    question[1] := map(question[1],&lcase,&ucase)
	    if Confirm("For ",Article(guess)," ",guess,", what would the _
		  answer be") then return Question(question,guess,node)
	    else return Question(question,node,guess)
	    }
	 }
      "Question": {
	 if Confirm(node.question) then 
	       node.yes := Ask(node.yes)
	 else
	       node.no := Ask(node.no)
	 }
      }
end

#
#  Article() -- Come up with the appropriate indefinite article.
#
procedure Article(word)
   return if any('aeiouAEIOU',word) then "an" else "a"
end

#
#  Save() -- Store our acquired knowledge in a disk file name
#  based on the GameObject.
#
procedure Save()
   local f
   f := open(GameObject || "s","w")
   Output(Tree,f)
   close(f)
   return
end

#
#  Output() -- Recursive procedure used to output the knowledge tree.
#
procedure Output(node,f,sense)
   static indent
   initial indent := 0
   /f := &output
   /sense := " "
   case type(node) of {
      "string":  write(f,repl(" ",indent),sense,"A: ",node)
      "Question": {
	 write(f,repl(" ",indent),sense,"Q: ", node.question)
	 indent +:= 1
	 Output(node.yes,f,"y")
	 Output(node.no,f,"n")
	 indent -:= 1
	 }
      }
   return
end

#
#  Get() -- Read in a knowledge base from a disk file.
#
procedure Get()
   local f
   f := open(GameObject || "s","r") | fail
   Tree := Input(f)
   close(f)
   return
end

#
#  Input() -- Recursive procedure used to input the knowledge tree.
#
procedure Input(f)
   local nodetype,s
   read(f) ? (tab(upto(~' \t')) & =("y" | "n" | "") &
	 nodetype := move(1) & move(2) & s := tab(0))
   return if nodetype == "Q" then Question(s,Input(f),Input(f)) else s
end

#
#  List() -- Lists the objects in the knowledge base.
#
procedure List()
   local lst,line,item
   lst := Show(Tree,[])
   line := ""
   every item := !sort(lst) do {
      if *line + *item > 78 then {
	 write(trim(line))
	 line := ""
	 }
      line ||:= item || ", "
      }
   write(line[1:-2])
   return
end

#
#  Show() -- Recursive procedure used to navigate the knowledge tree.
#
procedure Show(node,lst)
   if type(node) == "Question" then {
      lst := Show(node.yes,lst)
      lst := Show(node.no,lst)
      }
   else put(lst,node)
   return lst
end