############################################################################
#
#	Name:	animal.icn
#
#	Title:	Animal game
#
#	Author:	Robert J. Alexander
#
#	Date:	June 10, 1988
#
############################################################################
#  
#     This is the familiar ``animal game'' written in Icon.  The
#  program asks its human opponent questions in an attempt to guess
#  what animal he is thinking of.  It is an ``expert system'' that
#  starts out with limited knowledge, 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 game is not limited to guessing animals only.  By simply
#  modifying the first two lines of procedure "main" it will happily
#  guess things in other categories.  For example, the lines:
#  
#          GameObject := "president"
#          Tree := Question("Has he ever been known as Bonzo",
#             "Reagan","Lincoln")
#  
#  can be substituted and it works reasonably well.  The knowledge
#  files will be kept separate, too.
#  
#     Typing list at any yes/no prompt will show an inventory of
#  animals known, and there are some other commands (see procedure
#  Confirm).
#  
############################################################################

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

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

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

procedure Confirm(q1,q2,q3,q4,q5,q6)
  local answer,s
  static ok
  initial {
    ok := table()
    ok["y"] := ok["yes"] := ok["yeah"] := ok["uh huh"] := "yes"
    ok["n"] := ok["no"] := ok["nope"] := ok["uh uh"] := "no"
  }
  while /answer do {
    write(q1,q2,q3,q4,q5,q6,"?")
    case s := read() | exit(1) of {
      "save": Save()
      "get": Get()
      "list": List()
      "dump": Output(Tree,&output)
      default: {
	(answer := \ok[map(s,&ucase,&lcase)]) |
	      write("This is a \"yes\" or \"no\" question.")
      }
    }
  }
  return answer == "yes"
end

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

procedure Article(word)
  return if any('aeiouAEIOU',word) then "an" else "a"
end

procedure Save()
  local f
  f := open(GameObject || "s","w")
  Output(Tree,f)
  close(f)
  return
end

procedure Output(node,f,sense)
  static indent
  initial indent := 0
  /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

procedure Get()
  local f
  f := open(GameObject || "s","r") | fail
  Tree := Input(f)
  close(f)
  return
end

procedure Input(f)
  local nodetype,s
  read(f) ? (tab(upto(~' \t')) & =("y" | "n" | "") &
  	nodetype := move(1) & move(2) & s := tab(0))
  if nodetype == "Q" then {
    return Question(s,Input(f),Input(f))
  }
  else {
    return s
  }
end

procedure List()
  ShowLine := ""
  Show(Tree)
  write(trim(ShowLine))
  return
end

procedure Show(node)
  if type(node) == "Question" then {
    Show(node.yes)
    Show(node.no)
  }
  else {
    if *ShowLine + *node > 78 then {
      write(trim(ShowLine))
      ShowLine := ""
    }
    ShowLine ||:= node || "  "
  }
  return
end