OS/2 Shareware BBS: 10 Tools/10-Tools.zip/OL.LZH/PROGS.LZH/ANIMAL.ICN

Text File | 1991-07-13 | 6KB | 220 lines

############################################################################
#
#    Name:    animal.icn
#
#    Title:    Animal Guessing Game / "Expert System"
#
#    Author: Robert J. Alexander
#
#    Date:    April 25, 1990
#
############################################################################
#
#     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