;;;;;;;;;;;;;;;;;;;;;;;;<pre><xmp>
;;;
;;;; _*_ Mode: Lisp; Syntax: Common Lisp; Package: user _*_

;;; This file contains the ACT-R model of the
;;; word learning task.
 
;;; ACT-R version 4 required.

;;; to run the simulation call (run-it-word-learning #)
;;; where # is the number of subjects to simulate


;;;; Supplying data for the unknown word experiment.
;;;; correlation R^2

(defparameter *data-perc-corr-word-learning* 
    (make-array '(3 3 4)
		:initial-contents '(((47.08 79.92 78.13 81.08)
				     (54.92 68.46 79.38 83.08)
				     (85.75 80.90 77.48 82.02))
				    ((73.42 71.62 60.10 72.86)
				     (47.01 52.78 54.17 64.76)
				     (88.38 76.47 72.22 84.34))
				    ((91.41 84.95 60.14 81.94)
				     (80.11 71.81 71.43 72.52)
				     (82.91 72.07 79.05 78.65))))
  "Percentage of correct answers for real data.")


(defparameter *data-rt-corr-word-learning*
    (make-array '(3 3 4)
		:initial-contents '(((4558.50 3271.23 2882.10 2608.78)
				     (4884.67 4135.48 3270.35 2940.77)
				     (3585.37 3098.02 2924.49 2846.40))
				    ((4410.94 3665.91 3435.81 3219.84)
				     (5071.75 4403.68 3692.85 3496.18)
				     (3798.15 4287.79 3240.06 3258.17))
				    ((4230.49 3222.97 3330.90 2983.59)
				     (4784.78 3665.31 3015.69 3050.61)
				     (4404.69 3325.69 3220.60 2831.78))))
  "Response times for real data.")

(defparameter *data-def-ratings-no-ex-word-learning*
    (make-array '(2 2) 
		:initial-contents '((1.58 1.29) (0.56 1.09)))
  "Definition ratings in the absence of examples for real data")

(defparameter *data-def-ratings-ex-word-learning*
    (make-array '(2 2) 
		:initial-contents '((1.73 1.62) (1.05 1.61)))
  "Definition ratings in the absence of examples for real data")



;;;;=============================
;;;; 
;;;; materials for the meaning acquisition experiment

(defparameter +TOPICS-WORD-LEARNING+ 
  (list "athlete" "cold-room" "farmer" "food" "husband"   "official" 
	"politician" "waiter" "musician")
  "Story topics.")

(defparameter +UNKNOWNS-WORD-LEARNING+ 
  (list "carope" "zolper" "pinten")
  "List of artificial words.")

(defparameter +TRIALS-PER-BLOCK-WORD-LEARNING+ (length +TOPICS-WORD-LEARNING+)
  "Number of trials in each block; each trial corresponds to one topic.")

(defparameter +TRIALS-PER-COND-WORD-LEARNING+ (/ +TRIALS-PER-BLOCK-WORD-LEARNING+ 3)
  "Number of trials assigned to each condition.")

(defparameter +DUMMY-WORD-LEARNING+
  (list "dumm?" "dummy" '-y))

(defparameter +DUMMY-SUBJ-WORD-LEARNING+
  (list "dumb" "A" "B" "C"))

(defparameter +DUMMY-PRED-WORD-LEARNING+
  (list "ABCD" "B"))

(defparameter *inclusions-word-learning*
  ;;;need a fun to generate the other inclusions
  (list 
   (list "person" "animal")))

(defparameter +SOURCES-WORD-LEARNING+
  (list
   (list "bear" "animal" "massive" "bear")
   (list "freezer" "storage closet" "cold" "freezer")
   (list "ant" "animal" "hard-working" "ant")
   (list "rubber" "material" "tough" "rubber")
   (list "puppy" "animal" "submissive" "puppy")
   (list "iceberg" "thing"  "cold" "iceberg")
   (list "fox" "animal"  "stealing" "fox")
   (list "snail" "animal" "slow" "snail")
   (list "cricket" "animal" "unmusical" "cricket")))

(defparameter *athlete-stories-word-learning*
  (list
   ;;; the list of features for each story
   (list (list "Jim Smith" "person"  "massive" "athlete")
	 +DUMMY-SUBJ-WORD-LEARNING+ 
	;(list "other wrestler" "person" "massive" "athlete")
	 (list "was competing for national title"  "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "was competing for regional title"  "person"))
   (list (list "Linebacker" "person"  "massive" "athlete" )
	 (list "Jim" "person" "philosopher" "student")
	 (list "was sleeping in the philosophy class"   "animal")
	 (list "noticed a man sleeping in class" "person")
	 (list "noticed a man sleeping in class" "person"))
   (list (list "Joe" "person" "massive" "athlete" )
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "worked hard in his mountain house"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "worked hard in his city house"   "person"))
   (list (list "John Quinch" "person"  "massive" "athlete" )
	 (list "Mrs. Jones" "person" "amiable" "housewife")
	 (list "helped Mrs. Jones crack the nuts"   "animal")
	 (list "needed help to bake the cake." "person")
	 (list "needed help to bake the cake." "person"))
   (list (list "new skier" "person"  "massive" "athlete")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "was an outsider in the competition"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "lost the downhill competition"   "person"))   
   (list (list "Jim Smith" "person" "massive" "athlete" )
	 (list "squirrel" "animal" "little" "squirrel")
	 (list "lifted the trunk of the fallen tree"   "animal")
	 (list "was caught under the fallen tree"  "animal")
	 (list "was caught under the fallen tree"  "animal"))

   (list (list "Tom Smith" "person"  "massive" "athlete" )
	 (list "Maggie" "animal" "little" "cat")
	 (list "saved the life of his little cat"   "animal")
	 (list "was trapped in the burning house"  "animal")
	 (list "was trapped in the burning house"  "animal"))
   (list (list "new player" "person"  "massive" "athlete" )
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "improved considerably the hockey team play"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "did not improve the hockey team play"   "person"))))

(defparameter *cold-room-stories-word-learning*
  (list
   (list (list "bedroom" "location" "cold" "cold-room" )
	 (list "corridor" "location" "normal" "corridor")
	 (list "Mark spent his last Sunday night in"   "location")
	 (list "Tom and Mark met accidentally in a" "location")
	 (list "Tom and Mark met accidentally in a" "location"))
   (list (list "cold room" "location"  "cold" "cold-room" )
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "Jim forgot very soon about being in a"   "location")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "Only the last rows were occupied"   "location"))
   (list (list "office" "location" "cold"  "cold-room")
	 (list "room" "location" "unoccupied" "room")
	 (list "Jim wore several warm sweaters in"   "location")
	 (list "Jim's thermostat controlled an empty"   "location")
	 (list "Jim's thermostat controlled an empty"   "location"))
   (list (list "refuge" "location" "cold"  "cold-room")
	 (list "tent" "thing" "improvised" "tent")
	 (list "Tom and Jim couldn't sleep in the"   "location")
	 (list "Tom and Jim took their " "thing")
	 (list "Tom and Jim took their " "thing"))
   (list (list "holiday house" "location" "cold"  "cold-room")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "The Jones had no wood to warm the"   "location")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "The Jones used some wood to warm the"   "location"))
   (list (list "warehouse" "location" "cold"  "cold-room")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "Tom has been locked for hours in the"   "location")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "Tom caught a serious pneumonia in the"   "location"))
   (list (list "house" "location" "cold"  "cold-room")
	 (list "cottage" "location" "warm" "cottage")
	 (list "Thomas left the for a friend's house"   "location")
	 (list "Thomas moved to his friend's "   "location")
	 (list "Thomas moved to his friend's "   "location"))
   (list (list "car" "location" "cold"  "cold-room")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "Tom travelled in a all the way home"   "location")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "had no roof or doors or chairs"   "location"))))
       
(defparameter *farmer-stories-word-learning*
  (list 
   (list (list "Jim" "person" "hard-working" "farmer")
	 (list "uncle" "person" "dead" "relative")
	 (list "took two jobs to make more money"   "person")
	 (list "bequeathed a small farm to his nephew" "person")
	 (list "bequeathed a small farm to his nephew" "person"))
   (list (list "Joe1" "person" "hard-working" "farmer")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "worked hard to make his dream true"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "worked hard to buy a new city house"   "person"))
   (list (list "Joe Smith" "person" "hard-working" "farmer")
	 (list "wife" "person" "suggesting" "wife")
	 (list "did all the farming work by himself"   "person")
	 (list "suggested to try selling the farm" "person")
	 (list "suggested to try selling the farm" "person"))
   (list (list "Tom" "person" "hard-working" "farmer")
	 (list "worker" "person" "farm-working" "worker")
	 (list "prepared for the spring farming season"   "person")
	 (list "were hired to work the farm" "person")
	 (list "were hired to work the farm" "person"))
   (list (list "Joe Doe" "person" "hard-working" "farmer")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "reaped the wheat on his farming area"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "reaped the maze on his farming area"   "person"))
   (list (list "Mr. Jones" "person" "hard-working" "farmer")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "gathered the melons on the farm"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "gathered the pumpkins on the farm"   "person"))
   (list (list "Mr. Smith" "person" "hard-working" "farmer")
	 (list "horse" "animal" "traction" "horse")
	 (list "used his own horses for harvesting"   "person")
	 (list "were used to pull the harvester." "animal")
	 (list "were used to pull the harvester." "animal"))
   (list (list "Tom Smith" "person" "hard-working" "farmer")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "had a hard time gathering the crop"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "gathered his neighbor's corn crop"   "person"))))

(defparameter *food-stories-word-learning*
  (list
   (list (list "hamburger" "thing" "tough" "food")
	 (list "tooth" "thing" "loose" "body part")
	 (list "made Jim lose his incisor tooth"   "thing")
	 (list "Jim lost the"   "thing")
	 (list "Jim lost the"   "thing"))
   (list (list "chicken" "thing" "tough" "food")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "Everybody hated the served for dinner"   "thing")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "served for dinner was delicious"   "thing"))
   (list (list "steak" "thing" "tough" "food")
	 (list "potato" "thing" "sweet" "food")
	 (list "Marie prepared the for the special dinner"   "thing")
	 (list "Marie was pealing the " "thing")
	 (list "Marie was pealing the " "thing"))
   (list (list "turkey" "thing" "tough" "food")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "was prepared after the school recipe"   "thing")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "was prepared after her mother's recipe"   "thing"))
   (list (list "food" "thing" "tough" "food")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "Mr. Jones praised the  served for dinner"   
	       "thing")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "Mr. Black admitted that he hated that"   "thing"))
   (list (list "food2" "thing" "tough" "food")
	 (list "dish" "thing" "delicious" "food")
	 (list "the new chef of the restaurant cooked "   "thing")
	 (list "used to be delicious"    "thing")
	 (list "used to be delicious"    "thing"))
   (list (list "food3" "thing" "tough" "food")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "was thrown on the restaurant floor"   
	       "thing")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "Jim refused angrily the he was brought"    "thing"))
   (list (list "steak2" "thing" "tough" "food")
	 (list "steak" "thing" "good" "food")
	 (list "After marriage, Joan cooked for her husband"   
	       "thing")
	 (list "For her husband Joan wanted to prepare"    "thing")
	 (list "For her husband Joan wanted to prepare"    "thing"))))

(defparameter *husband-stories-word-learning*
  (list
   (list (list "husband" "person" "submissive" "husband")
	 (list "friend" "person" "nice" "friend")
	 (list "wouldn't go for a beer with his friend"   "person")
	 (list "asked his friend to go for a  beer"   "person")
	 (list "asked his friend to go for a  beer"   "person"))
   (list (list "husband1" "person" "submissive" "husband")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "went to the hair dresser's with Ann"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list  "went to the gym class with his wife"   "person"))
   (list (list "husband2" "person" "submissive" "husband")
	 (list "burglar" "person" "malintended" "burglar")
	 (list "didn't fight with the burglar"   "animal")
	 (list "In the vestibule there was a "   "animal")
	 (list "In the vestibule there was a "   "animal"))
   (list (list "husband3" "person" "submissive" "husband")
	 (list "Joe" "person" "observing"  "roomate")
	 (list "was afraid to catch a severe cold"   "person")
	 (list "was suprised by his roomate's attire" "person")
	 (list "was suprised by his roomate's attire" "person"))
   (list (list "husband4" "person" "submissive" "husband")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "did  many of the chores in the household"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "always cooked for his wife and kids"   "person"))
   (list (list "husband5" "person" "submissive" "husband")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "liked a blue tie with red spots"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "was too whimsical to like any tie"   "person"))
   (list (list "husband6" "person" "submissive" "husband")
	 (list "wife" "person" "active" "wife")
	 (list "ate raw eggs instead of cooked food"   "animal")
	 (list "was responsible for all the chores"  "animal")
	 (list "was responsible for all the chores"  "animal"))
   (list (list "husband7" "person" "submissive" "husband")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "always had his wife pay in the shops"    "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "lived solely on his wife's wages"   "person"))))

(defparameter *official-stories-word-learning* 
  (list
   (list (list "official" "person" "cold" "official")
	 (list "Mary" "person" "late" "student")
	 (list "didn't wait for Mary's transcripts"   "person")
	 (list "sent an incomplete application" "person")
	 (list "sent an incomplete application" "person"))
   (list (list "official1" "person" "cold" "official")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "refused Joe's and Mary's application"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "accepted Joe's and Mary's application"   "person"))
   (list (list "official2" "person" "cold" "official")
	 (list "Jim" "person" "running" "man")
	 (list "refused to open the door for Jim"   "person")
	 (list "ran to catch the leaving bus"  "person")
	 (list "ran to catch the leaving bus"  "person"))
   (list (list "clerk" "person" "cold" "official")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "didn't want to sell Jim a ticket"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "didn't want to talk with Jim"    "person"))
   (list (list "official3" "person" "cold" "official")
	 (list "Jerome" "person" "Zanish" "student")
	 (list  "will issue a Zanish transcript"   "person")
	 (list "was asking for an English transcript" "person")
	 (list "was asking for an English transcript" "person"))
   (list (list "official4" "person" "cold" "official")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "refused to give her bag back quickly"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "accepted to give up the formalities"   "person"))
   (list (list "official5" "person" "cold" "official")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list  "made Joan throw away her herbs"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "made Joan throw away her recipes"    "person"))
   (list (list "official6" "person" "cold" "official")
	 (list "Jon" "person" "insistent" "graduate")
	 (list  "was insensitive to Jon's arguments"   "person")
	 (list "had a degree from a foreign school" "person")
	 (list "had a degree from a foreign school" "person"))))


(defparameter *politician-stories-word-learning*
  (list 
   (list (list "politician" "person" "stealing" "politician")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "didn't keep his promises at all"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "made unresonable promises in the campaign"   "person"))
   (list (list "politician1" "person" "stealing" "politician")
	 (list "producer" "person" "cheap" "producer")
	 (list  "changed the doors in the hall"   "person")
	 (list  "money could be saved by buying from"   "person")
	 (list  "money could be saved by buying from"   "person"))
   (list (list "politician2" "person" "stealing" "politician")
	 (list "company" "thing" "rich" "company")
	 (list "received expensive gifts"   "person")
	 (list "gave many generous gifts"  "person")
	 (list "gave many generous gifts"  "person"))
   (list (list "politician3" "person" "stealing" "politician")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list  "had plastic surgery  for the campaign"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list  "took music lessons for the campaign"   "person"))
   (list (list "politician4" "person" "stealing" "politician")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list  "made the Rolls support him"   "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list  "The Rolls didn't vote for the"   "person"))
   (list (list "politician5" "person" "stealing" "politician")
	 (list "friend" "person" "fur-amateur" "woman")
	 (list  "misled people to gain their votes"   "person")
	 (list "showed some compromising pictures" "person")
	 (list "showed some compromising pictures" "person"))
   (list (list "politician6" "person" "stealing" "politician")
	 (list "assistant" "person" "inocent" "assistant")
	 (list  "was proved to be guilty of taking bribe"   "person")
	 (list "brought to light an old corruption history"  "person")
	 (list "brought to light an old corruption history"  "person"))
   (list (list "politician7" "person" "stealing" "politician")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list  "avoided visiting his old friends"  "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list  "visited his old friends weekly"    "person"))))
 
(defparameter *waiter-stories-word-learning*
  (list 
   (list (list "waiter" "person" "slow" "waiter")
	 (list "Jim" "person" "hurried" "man")
	 (list "made Jim be an hour late at the meeting"   "person")
	 (list "was an hour late at the meeting" "person")
	 (list "was an hour late at the meeting" "person"))
   (list (list "waiter1" "person" "slow" "waiter")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "were the worst part of the wedding"   "person") 
	 +DUMMY-PRED-WORD-LEARNING+
         (list "were the funniest part of the wedding"   "person"))
   (list (list "waiter2" "person" "slow" "waiter")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "didn't bring their bill in time"   "person") 
	 +DUMMY-PRED-WORD-LEARNING+
         (list  "didn't bring their dinner in time"   "person"))
   (list (list "waiter3" "person" "slow" "waiter")
	 (list "Cinderella" "person" "craving" "character")
	 (list "didn't bring the icecream in time"   "person") 
	 (list "waited for the chocolate icecream" "person")
	 (list "waited for the chocolate icecream" "person"))
   (list (list "waiter4" "person" "slow" "waiter")
	 (list "owner" "person" "not-understanding" "owner")
	 (list  "came from a country with unusual customs"   "person") 
         (list "wasn't understanding the Zanish customs." "person")
         (list "wasn't understanding the Zanish customs." "person"))
   (list (list "waiter5" "person" "slow" "waiter")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list  "served the champaign after midnight"   "person") 
	 +DUMMY-PRED-WORD-LEARNING+
         (list  "brought cold steak after midnight"   "person"))
   (list (list "waiter6" "person" "slow" "waiter")
	 (list "Tom" "person" "late" "skier")
	 (list "made Tom lose his last skiing run"   "person") 
	 (list "didn't dare to ski down in the night" "person")
	 (list "didn't dare to ski down in the night" "person"))
   (list (list "bartender" "person" "slow" "waiter")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "Jim was the only customer of the  that day"   
	       "person") 
	 +DUMMY-PRED-WORD-LEARNING+
         (list "prepared very quickly a pizza for Jim"   "person"))))

(defparameter *musician-stories-word-learning*
  (list
   (list (list "musician" "person" "unmusical" "musician")
	 (list "Jill" "person" "sleeping" "neighbor")
	 (list "woke the neighbor up at night" "animal")
	 (list "was waken up in the middle of the night" "animal")
	 (list "was waken up in the middle of the night" "animal"))
   (list (list "musician1" "person" "unmusical" "musician")
	 +DUMMY-SUBJ-WORD-LEARNING+
	 (list "played bass guitar in a rock band" "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "played mouth organ in a rock band" "person"))
   (list (list "musician2" "person" "unmusical" "musician")
         (list "Al" "person" "talented" "musician")
	 (list "was assigned to play the violin" "person")
	 (list "was assigned to play the piano" "person")
	 (list "was assigned to play the piano" "person"))
   (list (list "musician3" "person" "unmusical" "musician")
         +DUMMY-SUBJ-WORD-LEARNING+
         (list "failed to find a job in his hometown" "person")
	 +DUMMY-PRED-WORD-LEARNING+
	 (list "played the xylophone in his room" "person"))
   (list (list "musician4" "person" "unmusical" "musician")
        (list "grandpa" "person" "cellist" "musician")
	(list "wanted to learn to play the cello" "person")
	(list "used to play the cello in the orchestra" "person")
	(list "used to play the cello in the orchestra" "person"))
   (list (list "musician5" "person" "unmusical" "musician")
         +DUMMY-SUBJ-WORD-LEARNING+
	(list "sang but the music was awful" "person")
	+DUMMY-PRED-WORD-LEARNING+
	(list "was sung to but the music was awful" "person"))
   (list (list "musician6" "person" "unmusical" "musician")
         +DUMMY-SUBJ-WORD-LEARNING+
        (list "was annoying the people around him" "animal")
	+DUMMY-PRED-WORD-LEARNING+
	(list "was wearing a pink-and-orange bathsuit" "person"))
   (list (list "musician7" "person" "unmusical" "musician")
        (list "friend" "person" "well-intended" "musician")
	(list "The friend tried to persuade not to play" "person")
	(list "tried to persuade his friend not to play" "person")
	(list "tried to persuade his friend not to play" "person"))))
		 


(defparameter *stories-word-learning*
  (list (list "athlete"  *athlete-stories-word-learning*)
	(list "cold-room" *cold-room-stories-word-learning*)
	(list "farmer" *farmer-stories-word-learning*)
	(list "food" *food-stories-word-learning*)
	(list "husband" *husband-stories-word-learning*)
	(list "official" *official-stories-word-learning*)
	(list "politician" *politician-stories-word-learning*)
	(list "waiter" *waiter-stories-word-learning*)
	(list "musician" *musician-stories-word-learning*)))

(defparameter *targets-word-learning* 
  (mapcar #'(lambda (all-stories)
	      (list* (first all-stories)	;topic's name
		    (rest		;type, feature, category of
		     (first		;first subject of
		      (first		;first story with that topic in
		       (second all-stories)))))) ; list of all stories 
	  *stories-word-learning*)
  "List of meanings to be aquired.")


;;;; variables related to the implementation of the simulation

(defparameter +MET-CONDITION-WORD-LEARNING+ 0
  "Topic used in metaphorical condition.")

(defparameter +UNKN-CONDITION-WORD-LEARNING+ 1
  "Topic is used in unknown-word condition.")

(defparameter +LIT-CONDITION-WORD-LEARNING+ 2
  "Topic used in the literal condition.")

(defparameter +NO-BLOCKS-WORD-LEARNING+ 8
  "Number of blocks to be seen by one subject.")

(defvar *usage* nil
  "How the set of words has been used up to now.")

(defvar *crt-subject* nil
  "Data pertaining to the current subject.")

;;;; varaibles useful for data analysis

(defvar *perc-corr* 
  "Average percent of correct ans [type-of-trial, type-of-sent, block]
for the current subject.")

(defvar *rt-corr* 
  "Average Response times [type-of-trial, type-of-sent, block].")

(defvar *def-ratings* 
  "Average definition ratings [type-of-topic, trait]")


;;;; variables for running the experiment

(defvar *my-blc* 0)
(defvar *my-sl* 0.5)
(defvar *my-egs* 0.43)
(defvar *my-an*  nil)
(defvar *my-ia* 20)
(defvar *my-v* nil)
(defvar *my-lf* 1)
(defvar *text* t)
(defvar *graphic* nil)
(defvar *overlay* nil)

;;;; parameters to optimize

(defvar *ga-q* 1)			;q for give-answer
(defvar *gsa-q* 0.994)			;q for give-silly-answer

(defvar *nmn-q* 0.98)			;q for new-meaning-needed
(defvar *bm-q* 0.305) ;pred 0.311	;q for bad-meaning


(defvar *CORRECT-ANS* nil		;should be "true" or "false"
  "Keeps the correct answer for the current trial.")

(defvar *INCOMPLETE-WORD* nil
  "keeps the current word to be completed.")

(defvar *answer* nil
  "Keeps the actual answer given by subjects; can be one of the strings
  ``true'' or ``false''.")

(defvar *sentence-latency* nil
  "Keeps the latency of answering to one sentence.")

(defvar *start-time* nil
  "The time the computation has started at.")

(defvar *runs* 10)
(defvar *p* .35)

;;;; useful data structures

(defstruct (topic (:type list))
  topic
  (story-nos nil)			;list of stories with this topic
  (condition nil)		        ; 0 = metaphor
					; 1 = unknown word
					; 2 = literal

  (unknown-word nil)			; has sense only if condition = 
					;+UNKN-CONDITION-WORD-LEARNING+			
  (stream nil))				;int indicating current story

(defstruct (subject (:type list))
  (number 0)				;how many subjects have been before
  (out-stream nil)			;the output file
  (topics nil))				;a list of topics 



;;;;===================================
;;; Web interface

(defvar *WWW-interface*)

(setf *WWW-interface*
      '((:heading "The Word Learning Experiment" 2)
	(:new-para)
	(:table)

	(:table)
	"Conflict resolution noise (s): " (:string :sy *my-egs* .43) (:new-row)
        "Probability of creating a metaphoric extension (p): " (:string :sy *p* .35) (:new-row)
	"Number of runs (1-50): " (:string :sy *runs* 10) (:new-row)
	(:table-end)
       
	(:table)
	(:checkbox "Trace" :sy *my-v* nil) (:new-row)
	(:checkbox "Text output" :sy *text*  t) (:new-row)
        (:checkbox "Graphic output" :sy *graphic*  nil) (:new-row)
        (:checkbox "Show simulation and experiment data on one graph" :sy *overlay*  nil)
        (:table-end)
	(:table-end)

	(:new-para)
	(:button "Show Experiment Results" "(print-averages-word-learning nil)")

	(:new-para)
	(:button "Run Model" "(if (and (numberp *my-egs*) (numberp *runs*)
                                       (numberp *p*) (<= *p* 1) (>= *p* 0))
    (progn
      (setf *nmn-q* (1+ (* (/ *my-egs* 20) (log (/ *p* (- 1 *p*)) 2))))
      (if (and (> *nmn-q* 0) (<= *nmn-q* 1))
          (run-it-word-learning (min 50 (max 1 *runs*)))
        (format *standard-output* \"Illegal combination of p and s. p and s are not independent; there are tuples which give illegal values for the probability q of a production being successful.\")))
  (format *standard-output* \"Parameters must be numeric values\"))")

	(:reset "Default Values")
	(:button "Production Rules" "(let ((prods (no-output (pp))))
                                       (dolist (x prods)
                                          (pp-fct (list x))
                                          (spp-fct (list x))
                                          (format *standard-output* \"~%\")))")
	(:button "Chunk types" "(chunk-type)")
        (:button "Chunks" "(dm)")
	
	(:new-para)
	 "TIME and SIZE:"
	(:new-para)
	"- It usually takes about 1 minute for 10 runs of the model"
	(:new-line)
	"- The trace of 1 run is about 92K (65 pages) in size"
	(:new-para)))

	
	
(defun get-feedback-word-learning()
  *CORRECT-ANS*)


;;;; functions that create the main chunks

 

(defun make-object-word-learning (ch-name name type feature cat)
 (list ch-name 'isa 'object 'name name 
       'type type 'feature feature 'category cat))

(defun make-predicate-word-learning (p-name name requires)
  (list p-name 'isa 'predicate 'name name 'requires requires))

(defun make-story-fact-word-learning (sf-name s-name subj pred principal)
  (list sf-name 'isa 'story-fact 'story s-name 'subj subj
	'pred pred 'principal principal))

(defun make-story-word-learning (s-name)
  (list s-name 'isa 'chunk))

(defun make-inclusion-word-learning (ch-name included includer)
  (list ch-name 'isa 'inclusion 'included included 
	'includer includer))

(defun make-goal-word-learning (story subj-name pred-name feedback)
  (setq *CORRECT-ANS* feedback)
  (list 'goal 'isa 'extract-meaning
	'story story
	'sent-subj 'no-subj
	'sent-pred 'nil
	'sent-subj-name subj-name
	'sent-pred-name pred-name)) 


;;;; main simulation loop



(defun make-trial-word-learning (topic  
			crt-story subj1 subj2 pred1 
			pred2 false-pred)
  "Builds the chunks useful for the comprehension of the story."
  (declare (ignore crt-story))
  (let ((s1name nil)
	(s2name "nil")
	(p1name nil)
	(p2name "nil")
	(stname nil)
	(true (= (random 2) 0)))
    ;;; create the subj and predicate chunks
    (unless (easy-word-learning pred2)  ;(null subj2)
	(add-dm-fct 
	 (list
	  (apply #'make-object-word-learning (cons (setq s2name (gensym "obj"))
				     subj2))
	  (apply #'make-predicate-word-learning (cons (setq p2name (gensym "pred"))
					pred2)))))
    (when (easy-word-learning pred2)
      (setq s2name (make-intern-symbol-word-learning "dummy-subj")
	    p2name (make-intern-symbol-word-learning "dummy-pred")))
    
    (add-dm-fct 
     (list*
      (apply #'make-object-word-learning (cons (setq s1name (gensym "obj"))
				     subj1))
      (apply #'make-predicate-word-learning (cons (setq p1name (gensym "pred"))
				    pred1))
      (make-story-word-learning (setq stname (gensym "story")))
      (make-story-fact-word-learning (gensym "stfact")  stname 
		  s1name  p1name 1)
      (make-story-fact-word-learning (gensym "stfact")  stname 
		  s2name  p2name 2)
		       
      (when (and (not true) (easy-word-learning pred2)) ; or?
	 (list
	  (apply #'make-predicate-word-learning (cons (gensym "pred")
					false-pred))))))
	      
    ;;;create the goal chunk

    (add-dm-fct 
     (list
      (make-goal-word-learning stname 
		 
		       (cond ((= (topic-condition topic) +LIT-CONDITION-WORD-LEARNING+)
			      (first subj1))
			     ((= (topic-condition topic) +MET-CONDITION-WORD-LEARNING+)
			      (topic-source-word-learning topic))
			     (t (topic-unknown-word topic)))
		  
		       (if true (first pred1)  (first false-pred))
		 (if true "true" "false"))))

     ))

(defun init-subj-word-learning(subj-no output-on)
  "Initialize some global variables"
  (declare (ignore output-on))
  (setq *random-state* (make-random-state t))
  (setq *crt-subject*
	 (make-subject :topics
		       (mapcar #'(lambda (x)
				   (make-topic :topic x 
					       :story-nos 
					       (count-list-word-learning +NO-BLOCKS-WORD-LEARNING+)))
			       +TOPICS-WORD-LEARNING+) 
		       :out-stream
		       nil))

	;; read subj-number and assign metaphors to this subject

  (setf (subject-number *crt-subject*)
	subj-no)
    (when (null *usage*)
	  (setq *usage* 
		(mapcar #'(lambda(x)
			    (list x 0 0))
			+TOPICS-WORD-LEARNING+)))
    (setq *usage* (assign-topics-word-learning *usage*))

    ;;; record the way the topics should be used for this subject
    (let ((count 0))
      (mapc #'(lambda (x)
		(let ((topic (find (first x) 
				   (subject-topics *crt-subject*)
				   :key #'topic-topic
				   :test #'string=)))
		  (setf (topic-condition topic)
			(truncate (/ count +TRIALS-PER-COND-WORD-LEARNING+)))
		  (when (= +UNKN-CONDITION-WORD-LEARNING+ (topic-condition topic))
			(setf (topic-unknown-word topic)
			      (nth (mod count +TRIALS-PER-COND-WORD-LEARNING+)
				   +UNKNOWNS-WORD-LEARNING+)))
		  (incf count)))
	    *usage*)))


(defun assign-topics-word-learning(topic-ls)
 "Assigns each topic to one of three conditions: literal, metaphoric,
unknown word. Each condition should have an equal number of
topics. The argument is a list of items like (topic
#-met-cond-topic-has-been-in #-unknown-cond-topic-has-been-in). The
topics should be assigned such that #-met-cond.. is larger by at most
one than any other topic's #-met-cond.. The same should hold for
#-unknown-cond.... Returns the new topic list."
 (labels ((met-cnt (x) (second x))
	  (unkn-cnt (x) (third x)))

    (let ((met-sorted (sort topic-ls #'<= :key #'met-cnt))
	  (new-topic-ls nil))

     ;;; assign topics to the metaphoric condition
      (when (= (met-cnt (first met-sorted)) 
	       (met-cnt (last-elem-word-learning met-sorted)))
       (setq met-sorted (shuffle-list-word-learning met-sorted)))

    ;;; increment met-cnt for each list
      (setq new-topic-ls 
	    (append new-topic-ls
		    (mapcar #'(lambda (x)
				(incf (second x))
				x)
			    (firstk-word-learning met-sorted 
				    +TRIALS-PER-COND-WORD-LEARNING+
				    +TRIALS-PER-BLOCK-WORD-LEARNING+))))
      
      ;;; assign topics to the unknown word condition

   (let ((unknown-sorted (sort 
			  (lastk-word-learning met-sorted (* 2 +TRIALS-PER-COND-WORD-LEARNING+)
				 +TRIALS-PER-BLOCK-WORD-LEARNING+)
			  #'<= :key #'unkn-cnt)))
     (when (= (unkn-cnt (first unknown-sorted)) 
	      (unkn-cnt (last-elem-word-learning unknown-sorted)))
	   (setq unknown-sorted (shuffle-list-word-learning unknown-sorted)))

     ;;; update the unkn-cnt
     (setq new-topic-ls (append new-topic-ls
				(mapcar #'(lambda (x)
					    (incf (third x))
					    x)
					(firstk-word-learning unknown-sorted
					+TRIALS-PER-COND-WORD-LEARNING+
					(- +TRIALS-PER-BLOCK-WORD-LEARNING+
					   +TRIALS-PER-COND-WORD-LEARNING+)))))
     (append new-topic-ls
	     (lastk-word-learning unknown-sorted +TRIALS-PER-COND-WORD-LEARNING+ 
		    (- +TRIALS-PER-BLOCK-WORD-LEARNING+ +TRIALS-PER-COND-WORD-LEARNING+)))))))


(defun run-it-word-learning (&optional (no-subjects 40) (output-on nil))
  "Run a simulation of the meaning acquisition experiment."
   (let ((def-stream
	  nil)
	(eff-subj-no (make-array '(3 3 4) :initial-element 0))
	(corr-eff-subj-no (make-array '(3 3 4) :initial-element 0)))		
    (setq *perc-corr* (make-array '(3 3 4) :initial-element 0))
    (setq *rt-corr* (make-array '(3 3 4) :initial-element 0))
    (setq *def-ratings* (make-array '(2 2) :initial-element 0))

       (format def-stream "~&Metaphors ~T~T~T Unknowns")
    (format def-stream "~& Subj ~T Feat ~T Cat ~T~T Feat ~T Cat")


    (dotimes (subj-no no-subjects)
      ;(format t "~&Subject ~S" subj-no) 
      (init-subj-word-learning subj-no output-on)
      (let  ((number-corr (make-array '(3 3 4) :initial-element 0))
	     (number-trials (make-array '(3 3 4) :initial-element 0))
	     (rt-corr (make-array '(3 3 4) :initial-element 0))
	     ;; the indices in these arrays are trial-type X sent-type X block

	     (mets (remove-if-not #'(lambda(x)
				      (= (topic-condition x) +MET-CONDITION-WORD-LEARNING+))
				  (subject-topics *crt-subject*)))
	     (unkns (remove-if-not #'(lambda(x)
				       (= (topic-condition x) +UNKN-CONDITION-WORD-LEARNING+))
				   (subject-topics *crt-subject*))))
	
       ;;; write down how topics have been assigned for this subject

       (format (subject-out-stream *crt-subject*)
	      "~&Metaphors: ")
      (dolist (met mets)
	(format (subject-out-stream *crt-subject*) "~A " 
		(topic-topic met)))
      (format (subject-out-stream *crt-subject*)
	      "~&Unknown words:")
      (dolist (unk unkns)
	(format (subject-out-stream *crt-subject*) "<~A, ~A> "
		(topic-topic unk) (topic-unknown-word unk)))
    
      (format (subject-out-stream *crt-subject*)
	      "~&~A~T~A~T~A~T~A~T~A~T~A~T~A" "Story" "St Read"
	      "Sen Really" "Sen Eval" "Sen by subj" "Pr Compl" "Relev")  

       
       ;;;; prepare the declarative and procedural memo of the subject
       ;;;; and create a goal for him

      ;(load-model "meaning.lisp")
      
       (reset)



      (sgp-fct (list ':blc *my-blc* 
		     ':egs *my-egs* ':an *my-an* ':lf *my-lf*
		     ':sl *my-sl* ':v *my-v*))

      (spp-fct (list
		(list 'new-meaning-needed ':q *nmn-q*)))

       ;;; add the objects to DM
      (add-dm-fct
       (list*
	(apply #'make-object-word-learning (cons (make-intern-symbol-word-learning "dummy-subj")
				   +DUMMY-SUBJ-WORD-LEARNING+))
	(apply #'make-predicate-word-learning (cons (make-intern-symbol-word-learning 
				       "dummy-pred") +DUMMY-PRED-WORD-LEARNING+))
	(mapcar #'(lambda (src)
		    (apply #'make-object-word-learning 
			   (cons (make-intern-symbol-word-learning (first src)) src)))
		+SOURCES-WORD-LEARNING+)))


;;; add the inclusions
      (add-dm-fct
       (mapcar  #'(lambda (incl)
		    (apply #'make-inclusion-word-learning (cons (gensym "incl") incl))) 
		*inclusions-word-learning*))

      ;(set-all-base-levels-fct  5 -10)
      (dotimes (block +NO-BLOCKS-WORD-LEARNING+)
	
	(do* ((topic (rand-elem-word-learning (subject-topics *crt-subject*)
				+TRIALS-PER-BLOCK-WORD-LEARNING+)
		     (when left-topics 
		       (rand-elem-word-learning left-topics  (length left-topics))))
	      (left-topics (remove topic (subject-topics *crt-subject*)
				   :test #'equal)
			   (remove topic left-topics :test #'equal))
	      (crt-story (choose-story-word-learning topic block)
			 (when topic (choose-story-word-learning topic block)))
     	      (stop nil))
	    (stop)
	       
	     ;;; crt story is added to DM
	  (apply #'make-trial-word-learning (list* topic
				     crt-story ;block 
				     (get-story-word-learning crt-story
						(topic-topic topic))))
	  
		   
	     
	  (setq *start-time* *time*)
	  (goal-focus goal)

	  (run)
	     
	     ;;; write down data for this trial
	  (format (subject-out-stream *crt-subject*)
		  "~&~A~T~A~T~A~T~A~T~A~T~A~T~A~T"  
		  (concatenate 'string 
			       (string (topic-topic topic))
			       (string (digit-char (1+ crt-story))))
		  5000 *CORRECT-ANS* *sentence-latency* *answer* 
		  5000 "true")  

	  ;;; write down data related to experiment analysis 
	  
	    (let ((sent-type (if (string= *CORRECT-ANS* "true")
				 0
			         (if (hard-p-word-learning (topic-topic topic) 
					     (1+ crt-story))
				     1
				     2)))
		  (bl (floor (/ block 2))))
	      
	      (incf (aref number-trials sent-type (topic-condition topic)
			  bl))
	      (when (string= *CORRECT-ANS* *answer*)
		(incf (aref number-corr sent-type (topic-condition topic) 
			 bl))
		(incf (aref rt-corr sent-type (topic-condition topic) 
			    bl) *sentence-latency*)))
	      

	
	  (delete-chunk goal)
	  (setq stop (null left-topics))))
    
      (let ((m-rate nil)
	    (u-rate nil))
	(setq m-rate 
	      (reduce #'(lambda(sum rate)
			  (mapcar #'+ sum rate))
		      (mapcar #'rate-meaning-word-learning mets))
	      u-rate 
	      (reduce #'(lambda(sum rate)
			  (mapcar #'+ sum rate))
		      (mapcar #'rate-meaning-word-learning unkns)))
	 
	(format def-stream "~&~A~T~4F~T~4F~T~T~4F~T~4F"
		(subject-number *crt-subject*)
		(first m-rate) (second m-rate)
		(first u-rate) (second u-rate))
	
	(mapc #'(lambda(ind val)
		  (incf (aref *def-ratings* 0 ind) val))
	      '(0 1)
	      m-rate)

	(mapc #'(lambda(ind val)
		  (incf (aref *def-ratings* 1 ind) val))
	      '(0 1)
	      u-rate))
      
      (dotimes (sent-type 3)
	(dotimes (cond 3)
	  (dotimes (bl 4)
	    (unless (= 0 (aref number-trials sent-type cond bl))
	      (incf (aref eff-subj-no sent-type cond bl))
	      (incf (aref *perc-corr* sent-type  cond bl)
		    (* 100 (/ (aref number-corr  sent-type cond bl)
			      (aref number-trials  sent-type cond bl))))
	      (unless (= 0 (aref number-corr sent-type cond bl)) 
		(incf (aref corr-eff-subj-no sent-type cond bl))
		(incf (aref *rt-corr* sent-type cond bl)
		      (/ (aref rt-corr sent-type cond bl)
			 (aref number-corr sent-type cond bl)))))))))

      
      (when output-on (close (subject-out-stream *crt-subject*))))
    (when output-on (close def-stream))
    
    ;;; compute averages
    (dotimes (sent-type 3)
	(dotimes (cond 3)
	  (dotimes (bl 4)
	    (setf (aref *perc-corr* sent-type cond bl)
	      (/ (aref *perc-corr* sent-type cond bl)
		 (non-zero-word-learning (aref eff-subj-no sent-type cond bl))))
	    (setf (aref *rt-corr* sent-type cond bl)
	      (/ (aref *rt-corr* sent-type cond bl)
		 (non-zero-word-learning (aref corr-eff-subj-no sent-type cond bl))))))))
  
  (dotimes (ind1 2)
    (dotimes (ind2 2)
      (setf (aref *def-ratings* ind1 ind2)
	    (/ (aref *def-ratings* ind1 ind2) no-subjects))))

  (print-averages-word-learning t))

(defun choose-story-word-learning (topic block)
  "Chooses a story for displaying."
  ;;; if block is 0 or 1  or +NO-BLOCKS-WORD-LEARNING+ - 2, +NO-BLOCKS-WORD-LEARNING+ - 1
  ;;; then the corresponding story in the file-names of topic is selected;
  ;;; otherwise, a random one is chosen.
  ;;; topic is modified 
  (let* ((first-init (if (oddp (subject-number *crt-subject*))
			 (- +NO-BLOCKS-WORD-LEARNING+ 2)
		         0))
	 (middle-init (if (oddp (subject-number *crt-subject*))
			  2
			  0))
	 (el
	  (cond ((= block 0) 
		 (rand-elem-word-learning (topic-story-nos topic) 2 first-init))
		((= block 1)  
		 (rand-elem-word-learning (topic-story-nos topic) 1 first-init))
		((= block (- +NO-BLOCKS-WORD-LEARNING+ 2)) 
		 (rand-elem-word-learning (topic-story-nos topic) 2))
		((= block (- +NO-BLOCKS-WORD-LEARNING+ 1))
		 (first (topic-story-nos topic)))
		(t (rand-elem-word-learning (topic-story-nos topic)
			      (- +NO-BLOCKS-WORD-LEARNING+ block 2)
			      middle-init)))))
    (setf (topic-story-nos topic)
	  (remove  el (topic-story-nos topic) :test #'=))
    el))

(defun get-story-word-learning (story-no target)
  (nth story-no
       (second (find target *stories-word-learning* :key #'first :test #'string=))))

(defun topic-source-word-learning (topic)
  (first (nth (position (topic-topic topic) +TOPICS-WORD-LEARNING+) +SOURCES-WORD-LEARNING+)))


(defun easy-word-learning (pred)
  (and (string= (first pred) (first +DUMMY-PRED-WORD-LEARNING+))
       (string= (second pred) (second +DUMMY-PRED-WORD-LEARNING+))))

(defun rate-chunk-word-learning (topic chunk)
  "Rate the goodness of the new meaning."
  ; topic is a string return a pair (feature-rating cat-rating);
  ; feature is rated on a scale from 0 to 1
  ; category is rated on a scale form 0 to 1 
  (let ((c-rating 0)
	(f-rating 0))
    (when (string= (tg-type-word-learning topic) (chunk-slot-value-fct chunk 'type))
      (incf c-rating 0.5)
      (when (string= (tg-category-word-learning topic) (chunk-slot-value-fct chunk 'category))
	 (incf c-rating 0.5)))
    (when (string= (tg-feature-word-learning topic) (chunk-slot-value-fct  chunk 'feature))
	 (incf f-rating))
    (list f-rating c-rating)))


(defun tg-type-word-learning(target)
  (second (assoc target *targets-word-learning* :test #'equal)))

(defun tg-category-word-learning(target)
  (fourth (assoc target *targets-word-learning* :test #'equal)))

(defun tg-feature-word-learning(target)
  (third (assoc target *targets-word-learning* :test #'equal)))

(defun rate-meaning-word-learning (topic)
  
    (setq *command-trace* nil)
  (let* ((chunks (sdm-fct (list 'isa 'object 'name 
			 (cond ((= (topic-condition topic) +MET-CONDITION-WORD-LEARNING+)
				(topic-source-word-learning topic))
			       ((= (topic-condition topic) +UNKN-CONDITION-WORD-LEARNING+)
				(topic-unknown-word topic)))
			 'type (tg-type-word-learning (topic-topic topic)))))
	 (ratings (mapcar #'(lambda (chunk)
			      (rate-chunk-word-learning (topic-topic topic) chunk))
			  chunks))
	 (sum (list 0 0))
	 (prob (/ 1 (if (= (length chunks) 0) 1 (length chunks)))))

    (mapcar #'(lambda(rating) 
		(incf (first sum) (* prob (first rating)))
		(incf (second sum) (* prob (second rating))))
	    
	    ratings)
    (setq *command-trace* t)
    sum))
	  

(defun hard-p-word-learning (topic crt-story)
  (or (and (string= topic "athlete") 
	   (member crt-story '(2 4 6 7) :test #'=))
      (and (string= topic "cold-room")
	   (member crt-story '(1 3 4 7)))
      (and (string= topic "farmer")
	   (member crt-story '(1 3 4 7)))
      (and (string= topic "food")
	   (member crt-story '(1 3 6 8)))
      (and (string= topic "husband")
	   (member crt-story '(1 3 4 7)))
      (and (string= topic "musician")
	   (member crt-story '(1 3 6 8)))
      (and (string= topic "official")
	   (member crt-story '(1 3 5 8)))
      (and (string= topic "politician")
	   (member crt-story '(2 3 6 7)))
      (and (string= topic "waiter")
	   (member crt-story '(1 4 5 7)))))

(defun print-averages-word-learning (simulation)
  (let ((sim nil))
    (when *text*
      (dotimes (i (if (and simulation *overlay*) 2 1))
        (cond ((null *overlay*) (setf sim simulation))
              ((= i 0) (setf sim nil))
              (t (setf sim t)))
        
        (format t "~%~%Data for ~A:" (if sim "Simulation" "Experiment"))
        (dotimes (sent 3)
          (cond ((= sent 0)
	         (format t "~%~% Trues"))
	        ((= sent 1)
	         (format t "~%~% Hard Foils"))
	        ((= sent 2)
	         (format t "~%~% Easy Foils")))
          (format t "~&====================")
          
          (dotimes (trial 3)
            (cond ((= trial +LIT-CONDITION-WORD-LEARNING+)
	           (format t "~%~% Literals"))
	          ((= trial +MET-CONDITION-WORD-LEARNING+)
	           (format t "~%~% Metaphors"))
	          ((= trial +UNKN-CONDITION-WORD-LEARNING+)
	           (format t "~%~% Artificial Words")))
            
            (format t "~&Block   Perc Corr    RT")
            (dotimes (block 4)
	      (format t "~&~2@A       ~6,2F    ~7,2F" (1+ block) 
		      (aref (if sim *perc-corr* *data-perc-corr-word-learning*) sent trial block)
		      (aref (if sim *rt-corr* *data-rt-corr-word-learning*) sent trial block)))))
        
        (format t "~2%Definitions")
        (format t "~&==============")
        (let ((header (if (not sim) 
                          (list "~&No Examples" "~&Examples") 
                          (list "")))
              (defs (if sim (list *def-ratings*) 
                        (list *data-def-ratings-no-ex-word-learning* *data-def-ratings-ex-word-learning*))))
          (dotimes (i (length header))
            (format t (nth i header))
            (format t "~&Metaphors    Artificial words")
            (format t "~&Feat  Cat    Feat  Cat")
            (format t "~&~4,2F  ~4,2F   ~4,2F  ~4,2F" 
                    (aref (nth i defs) 0 0)
                    (aref (nth i defs) 0 1)
                    (aref (nth i defs) 1 0)
                    (aref (nth i defs) 1 1))))))

    (when *graphic*
    (dotimes (i 3)
      (format *standard-output* "~%~%
        <applet
        code = \"DansGraphs.class\"
        width = 400
        height = 400>

        <PARAM name=\"title\" value=\"Percent correct for ~A\">
        <PARAM name=\"longestline\" value=\"4\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xmin\" value=\"1\">
        <PARAM name=\"xmax\" value=\"4\">
        <PARAM name=\"ymax\" value=\"100\">
        <PARAM name=\"ymin\" value=\"0\">
        <PARAM name=\"ydiv\" value=\"5\">
        <PARAM name=\"yspacing\" value=\"10\">
        <PARAM name=\"xspacing\" value=\"1\">
        <PARAM name=\"xname\" value=\"Block\">
        <PARAM name=\"yname\" value=\"% correct\">
        <PARAM name=\"xval0\" value=\"1;2;3;4;\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"name0\" value=\"~a\">
        <PARAM name=\"xval1\" value=\"1;2;3;4;\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"name1\" value=\"~a\">
        <PARAM name=\"xval2\" value=\"1;2;3;4;\">
        <PARAM name=\"lcolor2\" value=\"2\">
        <PARAM name=\"lstyle2\" value=\"~s\">
        <PARAM name=\"name2\" value=\"~a\">

"
            (nth i (list "Trues" "Hard Foils" "Easy foils"))
            (if (and simulation *overlay*) 6 3)
            (if simulation 2 6553)
            (if simulation "Metaphors Simulation Data" "Metaphors Experiment Data") 
            (if simulation 2 6553)
             (if simulation "Artifical words Simulation Data" "Artifical words Experiment Data")
            (if simulation 2 6553)
            (if simulation "Literals Simulation Data" "Literals Experiment Data")
            )

      (dotimes (j 3)
        (format *standard-output* "<PARAM name=\"yval~S\" value=\"" j)

        (dotimes (k 4)
          (format *standard-output* "~f;" (aref (if sim *perc-corr* *data-perc-corr-word-learning*) i j k)))

        (format *standard-output* "\">"))

    


    (when (and *overlay* simulation)
      (format *standard-output* "
        <PARAM name=\"xval3\" value=\"1;2;3;4;\">
        <PARAM name=\"lcolor3\" value=\"0\">
        <PARAM name=\"lstyle3\" value=\"6553\">
        <PARAM name=\"name3\" value=\"Metaphors Experiment Data\">
        <PARAM name=\"xval4\" value=\"1;2;3;4;\">
        <PARAM name=\"lcolor4\" value=\"1\">
        <PARAM name=\"lstyle4\" value=\"6553\">
        <PARAM name=\"name4\" value=\"Artifical Experiment Data\">
        <PARAM name=\"xval5\" value=\"1;2;3;4;\">
        <PARAM name=\"lcolor5\" value=\"2\">
        <PARAM name=\"lstyle5\" value=\"6553\">
        <PARAM name=\"name5\" value=\"Literals words Experiment Data\">")

      (dotimes (j 3)
        (format *standard-output* "<PARAM name=\"yval~S\" value=\"" (+ 3 j))

        (dotimes (k 4)
          (format *standard-output* "~f;" (aref *data-perc-corr-word-learning* i j k)))

        (format *standard-output* "\">"))
      

      )

     

    (format *standard-output* "
             <HR> Your browser does not support JAVA, so you cannot view the graphs.~%
             </HR></applet>"))

    (dotimes (i 3)
      (format *standard-output* "~%~%
        <applet
        code = \"DansGraphs.class\"
        width = 400
        height = 400>

        <PARAM name=\"title\" value=\"RT for ~A\">
        <PARAM name=\"longestline\" value=\"4\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xmin\" value=\"1\">
        <PARAM name=\"xmax\" value=\"4\">
        <PARAM name=\"ymax\" value=\"5500\">
        <PARAM name=\"ymin\" value=\"2500\">
        <PARAM name=\"ydiv\" value=\"100\">
        <PARAM name=\"yspacing\" value=\"200\">
        <PARAM name=\"xspacing\" value=\"1\">
        <PARAM name=\"xname\" value=\"Block\">
        <PARAM name=\"yname\" value=\"RT (sec)\">
        <PARAM name=\"xval0\" value=\"1;2;3;4;\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"name0\" value=\"~a\">
        <PARAM name=\"xval1\" value=\"1;2;3;4;\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"name1\" value=\"~a\">
        <PARAM name=\"xval2\" value=\"1;2;3;4;\">
        <PARAM name=\"lcolor2\" value=\"2\">
        <PARAM name=\"lstyle2\" value=\"~s\">
        <PARAM name=\"name2\" value=\"~a\">

"
            (nth i (list "Trues" "Hard Foils" "Easy foils"))
            (if (and simulation *overlay*) 6 3)
            (if simulation 2 6553)
            (if simulation "Metaphors Simulation Data" "Metaphors Experiment Data") 
            (if simulation 2 6553)
            (if simulation "Artifical words Simulation Data" "Artifical words Experiment Data")
            (if simulation 2 6553)
            (if simulation "Literals Simulation Data" "Literals Experiment Data") 
            )

      (dotimes (j 3)
        (format *standard-output* "<PARAM name=\"yval~S\" value=\"" j)

        (dotimes (k 4)
          (format *standard-output* "~f;" (aref (if sim *rt-corr* *data-rt-corr-word-learning*) i j k)))

        (format *standard-output* "\">"))

    


    (when (and *overlay* simulation)
      (format *standard-output* "
        <PARAM name=\"xval3\" value=\"1;2;3;4;\">
        <PARAM name=\"lcolor3\" value=\"0\">
        <PARAM name=\"lstyle3\" value=\"6553\">
        <PARAM name=\"name3\" value=\"Metaphors Experiment Data\">
        <PARAM name=\"xval4\" value=\"1;2;3;4;\">
        <PARAM name=\"lcolor4\" value=\"1\">
        <PARAM name=\"lstyle4\" value=\"6553\">
        <PARAM name=\"name4\" value=\"Artifical Experiment Data\">
        <PARAM name=\"xval5\" value=\"1;2;3;4;\">
        <PARAM name=\"lcolor5\" value=\"2\">
        <PARAM name=\"lstyle5\" value=\"6553\">
        <PARAM name=\"name5\" value=\"Literals words Experiment Data\">")

      (dotimes (j 3)
        (format *standard-output* "<PARAM name=\"yval~S\" value=\"" (+ 3 j))

        (dotimes (k 4)
          (format *standard-output* "~f;" (aref *data-rt-corr-word-learning* i j k)))

        (format *standard-output* "\">"))
      

      )

     

    (format *standard-output* "
             <HR> Your browser does not support JAVA, so you cannot view the graphs.~%
             </HR></applet>"))



    (format *standard-output* "
        <applet
        code = \"DansGraphs.class\"
        width = 400
        height = 400>

        <PARAM name=\"title\" value=\"Accuracy of definitions\">
        <PARAM name=\"longestline\" value=\"2\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"4\">
        <PARAM name=\"ymax\" value=\"3.0\">
        <PARAM name=\"ymin\" value=\"0\">
        <PARAM name=\"ydiv\" value=\".5\">
        <PARAM name=\"numxlabels\" value=\"5\">
        <PARAM name=\"xlabels\" value=\" ;Feat; ;Cat; ;\">
        <PARAM name=\"widestxlabel\" value=\"WWWW\">
        <PARAM name=\"yspacing\" value=\"1\">
        <PARAM name=\"xname\" value=\"Type\">
        <PARAM name=\"yname\" value=\"Accuracy\">
        <PARAM name=\"xval0\" value=\"1;3;\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"name0\" value=\"~a\">
        <PARAM name=\"xval1\" value=\"1;3;\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"name1\" value=\"~a\">"
            (cond ((and simulation *overlay*) 6)
                  ((null simulation) 4)
                  (t 2))
            (if simulation 2 6553)
            (if simulation "Metaphors Simulation Data" "Metaphors Experiment Data (no example)")
            (if simulation 2 6553)
            (if simulation "Artifical words Simulation Data" "Artificial words Experiment Data (no example)"))



    (if (null simulation)
        (progn 
          (format t "
        <PARAM name=\"xval2\" value=\"1;3;\">
        <PARAM name=\"lcolor2\" value=\"0\">
        <PARAM name=\"lstyle2\" value=\"7801\">
        <PARAM name=\"name2\" value=\"Metaphors Experiment Data (example)\">
        <PARAM name=\"xval3\" value=\"1;3;\">
        <PARAM name=\"lcolor3\" value=\"1\">
        <PARAM name=\"lstyle3\" value=\"7801\">
        <PARAM name=\"name3\" value=\"Artifical words Experiment Data (example)\">
         ")

          (format *standard-output* "
          <PARAM name=\"yval0\" value=\"~F;~F;\">
          <PARAM name=\"yval1\" value=\"~F;~F;\">
          <PARAM name=\"yval2\" value=\"~F;~F;\">
          <PARAM name=\"yval3\" value=\"~F;~F;\">" 
                  (aref *data-def-ratings-no-ex-word-learning* 0 0)
                  (aref *data-def-ratings-no-ex-word-learning* 0 1)
                  (aref *data-def-ratings-no-ex-word-learning* 1 0)
                  (aref *data-def-ratings-no-ex-word-learning* 1 1)
                  (aref *data-def-ratings-ex-word-learning* 0 0)
                  (aref *data-def-ratings-ex-word-learning* 0 1)
                  (aref *data-def-ratings-ex-word-learning* 1 0)
                  (aref *data-def-ratings-ex-word-learning* 1 1)
                  ))
        (when *overlay*
            (format t "
        <PARAM name=\"xval2\" value=\"1;3;\">
        <PARAM name=\"lcolor2\" value=\"0\">
        <PARAM name=\"lstyle2\" value=\"6553\">
        <PARAM name=\"name2\" value=\"Metaphors Experiment Data (no example)\">
        <PARAM name=\"xval3\" value=\"1;3;\">
        <PARAM name=\"lcolor3\" value=\"1\">
        <PARAM name=\"lstyle3\" value=\"6553\">
        <PARAM name=\"name3\" value=\"Artifical words Experiment Data (no example)\">
        <PARAM name=\"xval4\" value=\"1;3;\">
        <PARAM name=\"lcolor4\" value=\"0\">
        <PARAM name=\"lstyle4\" value=\"7801\">
        <PARAM name=\"name4\" value=\"Metaphors Experiment Data (example)\">
        <PARAM name=\"xval5\" value=\"1;3;\">
        <PARAM name=\"lcolor5\" value=\"1\">
        <PARAM name=\"lstyle5\" value=\"7801\">
        <PARAM name=\"name5\" value=\"Artifical words Experiment Data (example)\">
         ")

          (format *standard-output* "
          <PARAM name=\"yval2\" value=\"~F;~F;\">
          <PARAM name=\"yval3\" value=\"~F;~F;\">
          <PARAM name=\"yval4\" value=\"~F;~F;\">
          <PARAM name=\"yval5\" value=\"~F;~F;\">" 
                  (aref *data-def-ratings-no-ex-word-learning* 0 0)
                  (aref *data-def-ratings-no-ex-word-learning* 0 1)
                  (aref *data-def-ratings-no-ex-word-learning* 1 0)
                  (aref *data-def-ratings-no-ex-word-learning* 1 1)
                  (aref *data-def-ratings-ex-word-learning* 0 0)
                  (aref *data-def-ratings-ex-word-learning* 0 1)
                  (aref *data-def-ratings-ex-word-learning* 1 0)
                  (aref *data-def-ratings-ex-word-learning* 1 1)
              
              )
            (format *standard-output* "
          <PARAM name=\"yval0\" value=\"~F;~F;\">
          <PARAM name=\"yval1\" value=\"~F;~F;\">
          " 
                  (aref *def-ratings* 0 0)
                  (aref *def-ratings* 0 1)
                  (aref *def-ratings* 1 0)
                  (aref *def-ratings* 1 1)
                  
                  )))

      

    (format *standard-output* "
             <HR> Your browser does not support JAVA, so you cannot view the graphs.~%
             </HR></applet>")








)))
      

  




;;;;============================
;;;; misc.lisp

;;;; file misc.lisp --- miscellaneous procedures


;;;; end of file functions
;;;;=====================

;;;;==================



(defun count-list-word-learning (n)
  "Returns the list (0 1 .. n-1)"
  (let ((result nil))
    (dotimes (cnt n (reverse result))
       (push cnt result))))

;;;; list functions
;;;; =============

(defun firstk-word-learning (list k n)
  "Returns the list made of the first k elements of list; n is the
length of list" 
  (butlast list (- n k)))

(defun lastk-word-learning (list k n)
  "Returns the list made of the last ``k'' elements of ``list''; ``n''
is the lenght of ``list''."
  (nthcdr (- n k) list))


(defun last-elem-word-learning (list)
  "Return the last element in a list."
  (first (last list)))

(defun rand-elem-word-learning (list size &optional (init 0))
  "Gets a random element from a list."
  (let ((which (+ (random size) init)))
    (values (nth which list) which)))

(defun shuffle-list-word-learning (b)
  "Shuffle the contents of a list."
    (do* ((el nil (rand-elem-word-learning tmp (length tmp)))
          (tmp b (remove el tmp :test #'equal))
          (result nil (cons el result)))
         ((= 0 (length tmp)) result)))


;;;; symbol functions
;;;;=================

(defun make-intern-symbol-word-learning (str)
  "Makes an internal symbol with the name ``str''."
 (intern (string-upcase str)))



;;;; analysis functions
;;;; =================
 

(defun non-zero-word-learning(x)
  (if (= x 0)
      1
      x))


;;;;===============================
;;;; model
;;;; file meaning.lisp: ACT-R model of the meaning acquisition experiment

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</xmp><pre><a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
(clear-all)

(sgp :era t
      :sl .5
     :g 20
     :le 1
     :rt -.01
     :v t
     :ol t
)

;;;; chunk types
;;;;===========

;;; we try to keep all the information related to a trial in a single
;;; chunk; this is ugly, but allows associations between context and
;;; sentence words

(chunk-type extract-meaning
	    story			;need it for association
	    sent-subj		      
	    sent-pred
	    sent-subj-name
	    sent-pred-name
)


(chunk-type object
	    name
	    type			;generic category (eg person etc)
	    category			;specific category (eg waiter)
	    feature			;salient feature
)

(chunk-type predicate
	    name 
	    requires
)

(chunk-type story-fact
	    subj
	    pred
	    story
	    principal
)


(chunk-type extract-2nd-meaning
	    sent-subj-name 
	    sent-subj			;old subject
	    new-subj
	    required-type 
            no-homo
)

(chunk-type build-meaning 
	    story
	    sent-subj		      
	    sent-pred
	    sent-subj-name
	    hypothesis			;can be 1 or 2 depending
					;whether the ne w meaning is
					;created around story-subj1 or
					;story-subj2
	    tried			;is t if it's the 2nd time you
					;try to build the same meaning
	    formed			;if t the meaning has been formed
	    cnt 
)
	    
(chunk-type create-meaning
	    name
	    center
	    related
	    new-meaning
            formed 
	    type
	    category
	    feature
)

(chunk-type refine-meaning
	    story
	    hypothesis
	    new-meaning
)

(chunk-type judge-sentence
	    story
	    sent-subj
	    sent-pred
	    answer
	    hypo
            retrieved-subj
            retrieved-principal
)

(chunk-type more-general
	    obj1 
	    obj2
	    answer1
	    answer2
	    answer
	    no-homo
            type1
            type2
            feature1
            feature2
            category1
            category2
)

(chunk-type answer
	    answer
	    feedback
	    story
	    sent-subj
	    sent-subj-name
	    sent-pred
	    silly
)

(chunk-type inclusion
	    included
	    includer
)

(chunk-type complete-word
	    story
	    subj
	    to-contain
	    missing
	    completed)

(chunk-type compare
            trait1
	    trait2
	    answer)

(chunk-type key-fact 
	    ans
	    key)


(add-dm
 (t isa chunk)
 (blank isa chunk)
 (no-subj isa object type "no-type" category "no-cat" 
          feature "no-feat" name "no-name")
 (press_right isa key-fact ans "true" key "K")
 (press_left isa key-fact ans "false" key "D"))

;;;; production rules
;;;;=================

;;;; 1. extract the meaning for subject and predicate

(p get-subj-meaning
   "Gets the meaning of the words that stands for the subject"
   =goal>
    isa extract-meaning
  - sent-pred nil
    sent-subj no-subj
    sent-subj-name =subj-name
   =subj>
    isa object
    name =subj-name
==>
   =goal>
    sent-subj =subj
)

(p get-pred-meaning 
   "Get the meaning of the word that stands for the predicate."
   =goal>
    isa extract-meaning
    sent-pred nil
    sent-pred-name =pred-name
   =pred>
    isa predicate
    name =pred-name
==>
   =goal>
    sent-pred =pred
)

(p guess-true
   "No meaning; guess."
 =goal>
     isa extract-meaning
     story =story
     sent-subj-name =s
     sent-subj no-subj
     sent-pred =sent-pred
  =stfact>
     isa story-fact
     story =story
     pred =sent-pred
==>
   !bind! =ans (if (= (random 3) 2) "false" "true") 
   =newgoal>
     isa answer
     story =story
     sent-subj no-subj
     sent-subj-name =s
     sent-pred =sent-pred
     answer =ans
     feedback nil
   !push! =newgoal
)


(p guess-false
"No meaning; guess."
 =goal>
     isa extract-meaning
     story =story
     sent-subj-name =s
     sent-subj no-subj
     sent-pred =sent-pred
 ==>
   =newgoal>
     isa answer
     story =story
     sent-subj no-subj
     sent-subj-name =s
     sent-pred =sent-pred
     answer "false"
     feedback nil
   !push! =newgoal
;   !eval! (when *debug* (goal-stack))
)


(p consistent-sent
   "The meanings of the subject and predicate agree."
   =goal>
     isa extract-meaning
     story =story
     sent-subj =subj
     sent-pred =pred
     - sent-subj no-subj
==>
   =newgoal>
     isa judge-sentence
     story =story
     sent-subj =subj
     sent-pred =pred
   ;!eval! (dm-fct (list =newgoal))
   !push! =newgoal
)

;;;; 2. meaning creation 

(p pred-match 
   "Try to match the sentence predicate against the principal story
predicate."
   =goal> 
    isa build-meaning 
    sent-pred =pred
    story =story
    hypothesis nil
   =story-fact>
    isa story-fact
    story =story
    pred =pred
    principal =h
==> 
    =goal>
     hypothesis =h
)


(p no-match
   "Sentence predicate matches none of the story predicates; answer false."
   =goal> 
    isa build-meaning
    sent-subj-name =sname
    sent-pred =pred
    sent-subj =subj
    story =story
    tried nil
    hypothesis nil
==> 
   =newgoal>
     isa answer
     sent-subj-name =sname
     sent-pred =pred
     story =story
     sent-subj =subj
     answer "false"
     feedback nil
   !push! =newgoal
)

(p create-meaning
   "Create a new meaning using the main subject as a meaning center."
   ;; should have r greater than pred2-match
   =goal>
    isa build-meaning
    story =story
    sent-subj =subj			;metaphor
    sent-subj-name =name
    formed "false"
    hypothesis =h
    cnt 0 
  =story-fact>
    isa story-fact
    subj =subj1
    story =story
    principal =h
==>
  =newgoal>
    isa create-meaning
    name =name
    center =subj1
    related =subj 
    formed "false"
    new-meaning =new
    type nil
    feature "none"
    category "none"
  =goal>
    formed "true"
    sent-subj =new
    cnt 1
  !push! =newgoal
)

(p get-type
   =goal>
    isa create-meaning
    name =name
    center =subj1
    formed "false"
    type nil
   =subj1>
    isa object
    type =type
==>
  =goal>
   formed "true"
   type =type
)

(p get-feature-from-met
   =goal>
     isa create-meaning
     related =subj
     type =type1
     feature "none"
     formed "true" 
     - related no-subj
   =subj>
     isa object
     feature =feat
     - type =type1
     - feature "none"
     - category "none"
==>
    =goal>
      feature =feat
)

(p get-feature
   =goal>
    isa create-meaning
    center =centr
    formed "true"
    - type nil
    feature "none"
    related no-subj
   =centr>
    isa object
    feature =feat
==>
    =goal>
     feature =feat
)

(p get-category
   =goal>
    isa create-meaning
    center =centr
    formed "true"
    - type nil
    category "none"
   =centr>
    isa object
    category =cat
==>
    =goal>
     category =cat
)

(p created-meaning
   "The meaning has been created; go back."
   =goal>
    isa create-meaning 
    formed "true"
    type =type
    category =cat
    name =name
    feature =feat
    - category "none"
==>
   =new>
     isa object
     name =name
     type =type
     category =cat
     feature =feat
   =goal>
     new-meaning =new
;   !eval! (when *debug* (dm-fct (list =new)))
   !pop!
)

;;; should be less probable    
     
(p answer
   "A (random) meaning has been created to match one of the subjects."
   =goal>
    isa build-meaning
    - hypothesis nil
    formed "true"
    tried nil
    story =st
    sent-subj =s
    sent-subj-name =sname
    sent-pred =pred
==>
   =newgoal>
     isa answer
     answer "true"
     feedback nil
     sent-subj =s
     sent-subj-name =sname
     sent-pred =pred
     story =st
   !push! =newgoal
)

(p stop
   "End of meaning re-creation; stop."
   =goal>
    isa build-meaning
    tried t
    formed "true"
==>
   !pop!
)

;;; 3. sentence judgement when meaning exists 

(p retrieve-subj
   "Match a literal sentence against the (subj1, pred1) pair."
   =goal>
     isa judge-sentence
     story =story
     sent-subj =subj
     sent-pred =pred
     - sent-subj no-subj
     retrieved-subj nil
   =story-fact>
     isa story-fact
     story =story
     subj =subj1
     pred =pred
     principal =h
==>
=goal>
    retrieved-subj =subj1
    retrieved-principal =h
)

(p match-lit
   "Match a literal sentence against the (subj1, pred1) pair."
   =goal>
     isa judge-sentence
     story =story
     sent-subj =subj
     retrieved-subj =subj
     sent-pred =pred
     - sent-subj no-subj
   =subj>
     isa object
     name =sname
==>
   =newgoal>
    isa answer
    answer "true"
    feedback nil
    story =story
    sent-subj =subj
    sent-subj-name =sname
    sent-pred =pred
   !focus-on! =newgoal
)


(p match-nonlit
   "Match a nonliteral sentence against a story (subj, pred) pair."
   =goal>
    isa judge-sentence
    story =story
    sent-subj =subj
  - retrieved-subj =subj
    retrieved-subj =subj1
    retrieved-principal =h
    sent-pred =pred
    answer nil
    hypo nil
    - sent-subj no-subj
==>
    =newgoal>
     isa more-general
     obj1 =subj
     obj2 =subj1
     answer =ans
   =goal>
     answer =ans
     hypo =h
   !push! =newgoal
)     

(p new-meaning-needed
   =goal>
    isa judge-sentence
    story =story
    answer "incompatible"
    sent-subj =s
    sent-pred =p
    hypo =h
    - sent-subj no-subj
   =s>
    isa object
    name =name
==>
   =newgoal>
    isa build-meaning
    story =story
    sent-subj =s
    sent-pred =p
    sent-subj-name =name
    hypothesis =h
    formed "false"
    cnt 0
  !pop!
  !focus-on! =newgoal
)



(p bad-meaning
   =goal>
    isa judge-sentence
    story =story
    answer "incompatible"
    sent-subj =s
    sent-pred =pred
    - sent-subj no-subj
   =s>
    isa object
    name =sname
==>
   =goal>
     answer "false"
   =newgoal>
     isa answer
     story =story
     sent-subj =s      
     answer "false"
     feedback nil
     sent-subj-name =sname
     sent-pred =pred
  !pop!
  !focus-on! =newgoal
)

(p wrong-pred
   =goal>
     isa judge-sentence
     story =story
     sent-subj =subj
     sent-pred =pred
     - sent-subj no-subj
     answer nil 
   =subj>
     isa object
     name =sname
==>
   =goal>
     answer "false"
   =newgoal>
     isa answer
     story =story
     sent-subj =subj      
     answer "false"
     feedback nil
     sent-subj-name =sname
     sent-pred =pred
  !focus-on! =newgoal
)

(p got-the-answer
  "The final answer has been found."
  =goal>
    isa judge-sentence
    hypo =hypo
    answer =ans
    story =story
    sent-subj =subj
    - sent-subj no-subj
    sent-pred =pred
    - answer nil
    - answer "incompatible"
  =subj>
    isa object
    name =sname
  ;!eval! (or (= =hypo 2) (string= =ans "true"))
==>
  =newgoal>
    isa answer
    story =story
    sent-subj =subj      
    answer =ans
    feedback nil
    sent-subj-name =sname
    sent-pred =pred
  !focus-on! =newgoal
)

;;; match two objects

(p retrieve-types
   =goal>
    isa more-general
    obj1 =obj1
    obj2 =obj2
    type1 nil
    answer1 nil ;- answer nil 
    answer2 nil
    - answer "incompatible"
   =obj1>
    isa object
    type =t1
    feature =f1
    category =c1
   =obj2>
    isa object
    type =t2
    feature =f2
    category =c2
==>
   =goal>
      type1 =t1
      type2 =t2
      feature1 =f1
      feature2 =f2
      category1 =c1
      category2 =c2
;   !eval! (when *debug* (dm-fct (list =goal)))
)


(p compare-objects
   "Set the goals to compare the features and the categories of 2 objects."
   =goal>
    isa more-general
    obj1 =obj1
    obj2 =obj2
    type1 =t
    type2 =t
    feature1 =f1
    feature2 =f2
    category1 =c1
    category2 =c2
    answer1 nil ;- answer nil 
    answer2 nil
==>
   =newgoal1>
    isa compare
    trait1 =f1
    trait2 =f2
    answer =ans1
   =newgoal2>
    isa compare
    trait1 =c1
    trait2 =c2
    answer =ans2
   =goal>
    answer1 =ans1
    answer2 =ans2

   !push! =newgoal2 
   !push! =newgoal1
   ;!eval! (dm-fct (list =newgoal1 =newgoal2))
)


(p homonym-needed
   =goal>
    isa more-general
    obj1 =o1
    obj2 =o2
    type2 =t2
  - type1 =t2
    answer1 nil
    answer2 nil
    no-homo nil
   =o1>
    isa object
    name =name
    - type =t2
    - feature "none"
    - category "none"
==>
  =newgoal>
    isa extract-2nd-meaning
    sent-subj-name =name
    sent-subj =o1
    required-type =t2
    new-subj =news
    no-homo =nh
   =goal>
    no-homo  =nh
    obj1 =news
    type1 nil
				     ;DOESN"T ACTUALLY TAKE NEW VAL
   !push! =newgoal
)

(p find-homonym
   "Find an homonym for the currrent subject."
   =goal>
    isa extract-2nd-meaning
    sent-subj-name =sname
    required-type  =type
    new-subj nil
    no-homo nil
   =new-subj>
    isa object
    name =sname
    type =type
==>
  =goal>
    new-subj =new-subj
    no-homo "false"
  !pop!
)

(p no-homonym
   "I have a meaning for the subject that doesn't agree with the
meaning for the predicate; and there's no homonym of the subject."
   =goal>
    isa extract-2nd-meaning
    sent-subj-name =sname
    sent-subj =subj			;!= nil
    required-type =type			;!= nil
    new-subj  nil
==>
  =goal>
    no-homo t
    new-subj =subj
  !pop!
)

(p incompatible
   =goal>
    isa more-general
    ;no-homo t
==>
  =goal>
    answer "incompatible"
  !pop!
)


(p compare-objects-done
   =goal>
     isa more-general
     obj1 =o1
     obj2 =o2
     answer1 =ans1
     answer2 =ans2
     answer nil
==>
    !bind! =ans (if (or (string= =ans1 "false")
			(string= =ans2 "false"))
		    "false"
		    "true")
    =goal>
     answer =ans
    !output! ("~s" =ans)
    !pop!
)

(p compare-traits-1
   "Compares the traits  of two objects."
   =goal>
     isa compare
     trait1 =t1
     trait2 =t2
     - answer "false"
   !eval! (or (string= =t1 "none") (string= =t1 =t2)) 
==>
   =goal>
    answer "true"
   !output! ("~S ~S" =t1 =t2)
   !pop!
)

(p compare-traits-2
   =goal>
    isa compare
     trait1 =t1
     trait2 =t2
==>
   !output! ("~S ~S" =t1 =t2)
   =goal>
     answer "false"
   !output! "false"
   !pop!
)


;;;; 4. get the feedback


(p give-answer
   "Give the answer and get the feedback."
   =goal>
     isa answer
     answer =ans
     feedback nil
   =key-fact>
     isa key-fact
     ans =ans
     key =key
==>
  !eval! (setq *answer* =ans) 
  !bind! =fdbk (get-feedback-word-learning)
  !output! ("~s ~s ~s" =ans =fdbk =key);
  !eval! (setq *sentence-latency* (* 1000 (- *time* *start-time*)))
  !output! ("~& Sent lat: ~s" *sentence-latency*) 
  =goal>
     feedback =fdbk
)

(p give-silly-answer
   "Give the answer and get the feedback."
   =goal>
     isa answer
     answer =ans
     feedback nil
   =key-fact>
     isa key-fact
     ans =ans
     key =key
==>
  !bind! =ans1 (if (string= =ans "true") "false" "true")
  !eval! (setq *answer* =ans1) 
  !bind! =fdbk (get-feedback-word-learning)
  !output! ("~s ~s" =ans1 =fdbk);
  !eval! (setq *sentence-latency* (* 1000 (- *time* *start-time*)))
  !output! ("~& Sent lat: ~s" *sentence-latency*) 
  =goal>
     feedback =fdbk
     answer =ans1
     silly t
)


(p good-feedback-1
   "The answer was right --- nothing left to do."
   =goal>
     isa answer
     answer =ans
     feedback =ans
     sent-subj =s1
     story =story
==>
   !output! ("~S ~S" =story =ans )
   !pop!
   !pop!
)

(p bad-feedback-1
   =goal>
     isa answer
     story =story
     sent-subj =s1
     answer =ans
     feedback =fbk
     silly nil
     - feedback =ans
   =fact>
     isa build-meaning
     story =story
     hypothesis =h
     tried nil
==>
   !pop!
   !output! ("~S ~S ~S" =h =story =fact)
;   !eval! (dm-fct (list =fact))
   ;;; change to the other hypothesis
   ;;; and recreate meaning
   !bind! =h1 (1+ (- 1 (- =h 1)))	;pick up the other hypothesis
   =fact>
    hypothesis =h1 
    tried t
    formed "false"
    cnt 0
    sent-subj no-subj
   !focus-on! =fact
)

(p bad-feedback-2
   =goal>
     isa answer
     story =story
     sent-subj =s1
     answer =ans
     feedback =fbk
     - feedback =ans
     sent-pred =pred
     sent-subj-name =sname
     silly nil
==>
   !output! ("~S~S" =ans =fbk)
   !pop!
   =newgoal2>
     isa build-meaning
     story =story
     hypothesis nil
     tried t
     sent-subj =s1 ;no-subj; =s1
     sent-subj-name =sname
     sent-pred  =pred
     formed "false"
     cnt 0
   !focus-on! =newgoal2
)

(p bad-feedback-3
   =goal>
     isa answer
     story =story
     sent-subj =s1
     answer =ans
     feedback =fbk
     - feedback =ans
     sent-pred =pred
     sent-subj-name =sname
     silly t
==>
   !output! ("~S~S" =ans =fbk)
   !pop!
   !pop!
)
   
(spp (good-feedback-1 :success t)
     (bad-feedback-1 :failure t)
     (bad-feedback-2 :failure t))


;;;; 5. refine the old meaning

(p refine-meaning
   =goal>
    isa refine-meaning
    story =story
    hypothesis =h
    new-meaning =subj
   =fact>
    isa create-meaning
    new-meaning =subj
   =st-fact>
    isa story-fact
    subj =s
    story =story
    principal =h
==>
   =fact>
     center =s
   !focus-on! =fact
)

(spp :references 100 :creation-time -40000  :effort .05)

(spp 
 (guess-true  :q 0.7 :effort 2.0) 
 (guess-false :q 0.485 :effort 2.0) 
 (find-homonym :success t)
 (no-homonym  :q 0.6 :failure t)
 (get-feature-from-met  :q 1.0) 
 (get-feature :q 0.71)
 (get-category  :q 1.0)
 (created-meaning :q 0.7)
 (answer :q 0.8)
 (match-lit  :effort .7)
 (new-meaning-needed  :q 0.98)
 (wrong-pred  :q 0.7 :effort 0.5)
 (incompatible  :q 0.4)
 (compare-traits-2  :q 0.7)
 (give-silly-answer  :q 0.94)
 (bad-feedback-2 :q 0.5)
 (bad-feedback-3 :q 1))

(spp retrieve-subj :creation-time -4000)
(spp Guess-false :effort 2.0)
(spp guess-true :effort 2.0)