############################################################################
#
#	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