home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sharew / exoten / icon / animal.icn < prev    next >
Encoding:
Text File  |  1990-03-08  |  4.6 KB  |  187 lines
  1. ############################################################################
  2. #
  3. #    Name:    animal.icn
  4. #
  5. #    Title:    Animal game
  6. #
  7. #    Author:    Robert J. Alexander
  8. #
  9. #    Date:    June 10, 1988
  10. #
  11. ############################################################################
  12. #  
  13. #     This is the familiar ``animal game'' written in Icon.  The
  14. #  program asks its human opponent questions in an attempt to guess
  15. #  what animal he is thinking of.  It is an ``expert system'' that
  16. #  starts out with limited knowledge, but gets smarter as it plays
  17. #  and learns from its opponents.  At the conclusion of a session,
  18. #  the program asks permission to remember for future sessions that
  19. #  which it learned.
  20. #  
  21. #     The game is not limited to guessing animals only.  By simply
  22. #  modifying the first two lines of procedure "main" it will happily
  23. #  guess things in other categories.  For example, the lines:
  24. #  
  25. #          GameObject := "president"
  26. #          Tree := Question("Has he ever been known as Bonzo",
  27. #             "Reagan","Lincoln")
  28. #  
  29. #  can be substituted and it works reasonably well.  The knowledge
  30. #  files will be kept separate, too.
  31. #  
  32. #     Typing list at any yes/no prompt will show an inventory of
  33. #  animals known, and there are some other commands (see procedure
  34. #  Confirm).
  35. #  
  36. ############################################################################
  37.  
  38. global GameObject,Tree,ShowLine,Learn
  39. record Question(question,yes,no)
  40.  
  41. procedure main()
  42.   GameObject := "animal"
  43.   Tree := Question("Does it live in water","goldfish","canary")
  44.   Get()        # Recall prior knowledge
  45.   Game()    # Play a game
  46.   return
  47. end
  48.  
  49. procedure Game()
  50.   while Confirm("Are you thinking of ",Article(GameObject)," ",
  51.       GameObject) do {
  52.     Ask(Tree)
  53.   }
  54.   write("Thanks for a great game.")
  55.   if \Learn &
  56.       Confirm("Want to save knowledge learned this session") then Save()
  57.   return
  58. end
  59.  
  60. procedure Confirm(q1,q2,q3,q4,q5,q6)
  61.   local answer,s
  62.   static ok
  63.   initial {
  64.     ok := table()
  65.     ok["y"] := ok["yes"] := ok["yeah"] := ok["uh huh"] := "yes"
  66.     ok["n"] := ok["no"] := ok["nope"] := ok["uh uh"] := "no"
  67.   }
  68.   while /answer do {
  69.     write(q1,q2,q3,q4,q5,q6,"?")
  70.     case s := read() | exit(1) of {
  71.       "save": Save()
  72.       "get": Get()
  73.       "list": List()
  74.       "dump": Output(Tree,&output)
  75.       default: {
  76.     (answer := \ok[map(s,&ucase,&lcase)]) |
  77.           write("This is a \"yes\" or \"no\" question.")
  78.       }
  79.     }
  80.   }
  81.   return answer == "yes"
  82. end
  83.  
  84. procedure Ask(node)
  85.   local guess,question
  86.   case type(node) of {
  87.     "string": {
  88.       if not Confirm("It must be ",Article(node)," ",node,", right") then {
  89.         Learn := "yes"
  90.         write("What were you thinking of?")
  91.     guess := read() | exit(1)
  92.     write("What question would distinguish ",Article(guess)," ",
  93.         guess," from ",Article(node)," ",node,"?")
  94.     question := read() | exit(1)
  95.     if question[-1] == "?" then question[-1] := ""
  96.     question[1] := map(question[1],&lcase,&ucase)
  97.     if Confirm("For ",Article(guess)," ",guess,", what would the _
  98.         answer be") then {
  99.       return Question(question,guess,node)
  100.     }
  101.     else {
  102.       return Question(question,node,guess)
  103.     }
  104.       }
  105.     }
  106.     "Question": {
  107.       if Confirm(node.question) then {
  108.         node.yes := Ask(node.yes)
  109.       }
  110.       else {
  111.         node.no := Ask(node.no)
  112.       }
  113.     }
  114.   }
  115. end
  116.  
  117. procedure Article(word)
  118.   return if any('aeiouAEIOU',word) then "an" else "a"
  119. end
  120.  
  121. procedure Save()
  122.   local f
  123.   f := open(GameObject || "s","w")
  124.   Output(Tree,f)
  125.   close(f)
  126.   return
  127. end
  128.  
  129. procedure Output(node,f,sense)
  130.   static indent
  131.   initial indent := 0
  132.   /sense := " "
  133.   case type(node) of {
  134.     "string":  write(f,repl(" ",indent),sense,"A: ",node)
  135.     "Question": {
  136.       write(f,repl(" ",indent),sense,"Q: ", node.question)
  137.       indent +:= 1
  138.       Output(node.yes,f,"y")
  139.       Output(node.no,f,"n")
  140.       indent -:= 1
  141.     }
  142.   }
  143.   return
  144. end
  145.  
  146. procedure Get()
  147.   local f
  148.   f := open(GameObject || "s","r") | fail
  149.   Tree := Input(f)
  150.   close(f)
  151.   return
  152. end
  153.  
  154. procedure Input(f)
  155.   local nodetype,s
  156.   read(f) ? (tab(upto(~' \t')) & =("y" | "n" | "") &
  157.       nodetype := move(1) & move(2) & s := tab(0))
  158.   if nodetype == "Q" then {
  159.     return Question(s,Input(f),Input(f))
  160.   }
  161.   else {
  162.     return s
  163.   }
  164. end
  165.  
  166. procedure List()
  167.   ShowLine := ""
  168.   Show(Tree)
  169.   write(trim(ShowLine))
  170.   return
  171. end
  172.  
  173. procedure Show(node)
  174.   if type(node) == "Question" then {
  175.     Show(node.yes)
  176.     Show(node.no)
  177.   }
  178.   else {
  179.     if *ShowLine + *node > 78 then {
  180.       write(trim(ShowLine))
  181.       ShowLine := ""
  182.     }
  183.     ShowLine ||:= node || "  "
  184.   }
  185.   return
  186. end
  187.