home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / animal.icn < prev    next >
Text File  |  2000-07-29  |  6KB  |  224 lines
  1. ############################################################################
  2. #
  3. #    File:     animal.icn
  4. #
  5. #    Subject:  Program to play "animal" guessing game
  6. #
  7. #    Author:   Robert J. Alexander
  8. #
  9. #    Date:     March 2, 1996
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #  
  17. #     This is the familiar ``animal game'' written in Icon.  The
  18. #  program asks its human opponent a series of questions in an attempt
  19. #  to guess what animal he or she is thinking of.  It is an ``expert
  20. #  system'' that starts out with limited knowledge, knowing only one
  21. #  question, but gets smarter as it plays and learns from its opponents.
  22. #  At the conclusion of a session, the program asks permission to
  23. #  remember for future sessions that which it learned.  The saved file
  24. #  is an editable text file, so typos entered during the heat of battle
  25. #  can be corrected.
  26. #  
  27. #     The game is not limited to guessing only animals.  By simply
  28. #  modifying the first two lines of procedure "main" a program can be
  29. #  created that will happily build a knowledge base in other categories.
  30. #  For example, the lines:
  31. #  
  32. #       GameObject := "president"
  33. #       Tree := Question("Has he ever been known as Bonzo",
  34. #          "Reagan","Lincoln")
  35. #  
  36. #  can be substituted, the program works reasonably well, and could even
  37. #  pass as educational.  The knowledge files will automatically be kept
  38. #  separate, too.
  39. #  
  40. #     Typing "list" at any yes/no prompt will show an inventory of
  41. #  animals known, and there are some other commands too (see procedure
  42. #  Confirm).
  43. #  
  44. ############################################################################
  45.  
  46. global GameObject,Tree,Learn
  47. record Question(question,yes,no)
  48.  
  49. #
  50. #  Main procedure.
  51. #
  52. procedure main()
  53.    GameObject := "animal"
  54.    Tree := Question("Does it live in water","goldfish","canary")
  55.    Get()     # Recall prior knowledge
  56.    Game()     # Play a game
  57.    return
  58. end
  59.  
  60. #
  61. #  Game() -- Conducts a game.
  62. #
  63. procedure Game()
  64.    while Confirm("Are you thinking of ",Article(GameObject)," ",GameObject) do
  65.      Ask(Tree)
  66.    write("Thanks for a great game.")
  67.    if \Learn &
  68.      Confirm("Want to save knowledge learned this session") then Save()
  69.    return
  70. end
  71.  
  72. #
  73. #  Confirm() -- Handles yes/no questions and answers.
  74. #
  75. procedure Confirm(q[])
  76.    local answer,s
  77.    static ok
  78.    initial {
  79.       ok := table()
  80.       every ok["y" | "yes" | "yeah" | "uh huh"] := "yes"
  81.       every ok["n" | "no"  | "nope" | "uh uh" ] := "no"
  82.       }
  83.    while /answer do {
  84.       every writes(!q)
  85.       write("?")
  86.       case s := read() | exit(1) of {
  87.      #
  88.      #  Commands recognized at a yes/no prompt.
  89.      #
  90.      "save": Save()
  91.      "get": Get()
  92.      "list": List()
  93.      "dump": Output(Tree)
  94.      default: {
  95.         (answer := \ok[map(s,&ucase,&lcase)]) |
  96.              write("This is a \"yes\" or \"no\" question.")
  97.         }
  98.      }
  99.       }
  100.    return answer == "yes"
  101. end
  102.  
  103. #
  104. #  Ask() -- Navigates through the barrage of questions leading to a
  105. #  guess.
  106. #
  107. procedure Ask(node)
  108.    local guess,question
  109.    case type(node) of {
  110.       "string": {
  111.      if not Confirm("It must be ",Article(node)," ",node,", right") then {
  112.         Learn := "yes"
  113.         write("What were you thinking of?")
  114.         guess := read() | exit(1)
  115.         write("What question would distinguish ",Article(guess)," ",
  116.             guess," from ",Article(node)," ",node,"?")
  117.         question := read() | exit(1)
  118.         if question[-1] == "?" then question[-1] := ""
  119.         question[1] := map(question[1],&lcase,&ucase)
  120.         if Confirm("For ",Article(guess)," ",guess,", what would the _
  121.           answer be") then return Question(question,guess,node)
  122.         else return Question(question,node,guess)
  123.         }
  124.      }
  125.       "Question": {
  126.      if Confirm(node.question) then 
  127.            node.yes := Ask(node.yes)
  128.      else
  129.            node.no := Ask(node.no)
  130.      }
  131.       }
  132. end
  133.  
  134. #
  135. #  Article() -- Come up with the appropriate indefinite article.
  136. #
  137. procedure Article(word)
  138.    return if any('aeiouAEIOU',word) then "an" else "a"
  139. end
  140.  
  141. #
  142. #  Save() -- Store our acquired knowledge in a disk file name
  143. #  based on the GameObject.
  144. #
  145. procedure Save()
  146.    local f
  147.    f := open(GameObject || "s","w")
  148.    Output(Tree,f)
  149.    close(f)
  150.    return
  151. end
  152.  
  153. #
  154. #  Output() -- Recursive procedure used to output the knowledge tree.
  155. #
  156. procedure Output(node,f,sense)
  157.    static indent
  158.    initial indent := 0
  159.    /f := &output
  160.    /sense := " "
  161.    case type(node) of {
  162.       "string":  write(f,repl(" ",indent),sense,"A: ",node)
  163.       "Question": {
  164.      write(f,repl(" ",indent),sense,"Q: ", node.question)
  165.      indent +:= 1
  166.      Output(node.yes,f,"y")
  167.      Output(node.no,f,"n")
  168.      indent -:= 1
  169.      }
  170.       }
  171.    return
  172. end
  173.  
  174. #
  175. #  Get() -- Read in a knowledge base from a disk file.
  176. #
  177. procedure Get()
  178.    local f
  179.    f := open(GameObject || "s","r") | fail
  180.    Tree := Input(f)
  181.    close(f)
  182.    return
  183. end
  184.  
  185. #
  186. #  Input() -- Recursive procedure used to input the knowledge tree.
  187. #
  188. procedure Input(f)
  189.    local nodetype,s
  190.    read(f) ? (tab(upto(~' \t')) & =("y" | "n" | "") &
  191.      nodetype := move(1) & move(2) & s := tab(0))
  192.    return if nodetype == "Q" then Question(s,Input(f),Input(f)) else s
  193. end
  194.  
  195. #
  196. #  List() -- Lists the objects in the knowledge base.
  197. #
  198. procedure List()
  199.    local lst,line,item
  200.    lst := Show(Tree,[])
  201.    line := ""
  202.    every item := !sort(lst) do {
  203.       if *line + *item > 78 then {
  204.      write(trim(line))
  205.      line := ""
  206.      }
  207.       line ||:= item || ", "
  208.       }
  209.    write(line[1:-2])
  210.    return
  211. end
  212.  
  213. #
  214. #  Show() -- Recursive procedure used to navigate the knowledge tree.
  215. #
  216. procedure Show(node,lst)
  217.    if type(node) == "Question" then {
  218.       lst := Show(node.yes,lst)
  219.       lst := Show(node.no,lst)
  220.       }
  221.    else put(lst,node)
  222.    return lst
  223. end
  224.