;;; File: test-suite.km
;;; Build Date:  Wed Apr 30 18:18:58 PDT 2008

(nocomments)
(fail-noisily)  ; (Report an error for NIL answers)

(print "userman.km")

;;; ======================================================================
;;;		 Demo KM commands from the KM User Manual
;;; To run the demo:
;;;	% lisp
;;;	> (load "km")
;;;	> (load-kb "userman.demo" :verbose 't)
;;; ======================================================================

(SETQ *LINEAR-PATHS* T)

(reset-kb)

(a Car)                     ; create an instance of a car

(Car has (superclasses (Vehicle)))

(every Car has
  (wheel-count (4))
  (parts ((a Engine) (a Chassis))))

(the parts of (a Car))

; ((a Car) parts)

(a Car)

(parts has
  (instance-of (Slot))
  (domain (Physobj))
  (range (Physobj))
  (cardinality (1-to-N))
  (inverse (part-of)))

(wheel-count has
  (instance-of (Slot))
  (domain (Vehicle))
  (range (Integer))
  (cardinality (N-to-1)))

(showme (thelast Car))     ; refers to the most recent instance of car

;;; ----------------------------------------

(Car has (superclasses (Vehicle)))

(every Car has
  (wheel-count (4))
  (fuel-type (*Gas))
  (parts ((a Engine) (a Chassis))))

(*Gas has       ; (NB no `every', as *Gas is an instance)
  (unit-cost (1.34)))

(Engine has (superclasses (Physobj)))

(every Engine has
  (material (*Metal)))

(Chassis has (superclasses (Physobj)))

(every Chassis has
  (material (*Metal *Plastic *Wood)))

(*Plastic has
  (instance-of (Synthetic-Material)))

;;; ----------------------------------------

(a Car)

(the unit-cost of (the fuel-type of (thelast Car)))

((thelast Car) fuel-type * unit-cost)

(the material of (the parts of (thelast Car)))

(the material of (the Engine parts of (thelast Car)))

((thelast Car) parts Engine material)

((thelast Car) parts Chassis material)

((thelast Car) parts Chassis material Synthetic-Material)

;(watchon)

((a Car) parts Chassis material Synthetic-Material)

;(watchoff)

(a Car)

(thelast Car)

(the Engine parts of (thelast Car))

(a Car with (color (*Red)))

(the color of (thelast Car))

;;; ----------------------------------------

(every Person has
  (favorite-color ((a Color))))

;; "All professors have (at least) one car which is old, is
;;  their favorite color, and was made in USA."
(Professor has (superclasses (Person)))

(every Professor has
  (owned-vehicle ((a Car with
    (age (*Old))
    (color ((the favorite-color of Self)))
    (made-by ((a Manufacturer with
      (location (*USA)))))))))

(a Professor with (favorite-color (*Blue)))

(the owned-vehicle of (thelast Professor))

(the color of (the owned-vehicle of (thelast Professor)))

(the location of (the made-by of 
	(the owned-vehicle of (a Professor))))

((a Professor) owned-vehicle * made-by * location)  ; alternative notation

;;;; ----------------------------------------

(reset-kb)

(has-engine has
  (instance-of (Slot))
  (domain (Vehicle))
  (range (Engine))
  (cardinality (1-to-1))); ie. a Vehicle has exactly one engine
; (single-valued slot)

(every Vehicle has 
  (has-engine ((a Engine with
                   (strength (*Powerful))))))

(Car has (superclasses (Vehicle)))

(every Car has
  (has-engine ((a Engine with
                   (size (*Average))))))

(showme (the has-engine of (a Car)))

;;; ----------------------------------------

(reset-kb)

(has-engine has
  (instance-of (Slot))
  (domain (Vehicle))
  (range (Engine))
  (cardinality (1-to-1)))

(fuel has
  (instance-of (Slot))
  (domain (Vehicle))
  (range (Gas))
  (cardinality (1-to-1)))

(every Vehicle has 
  (has-engine ((a Engine with
                   (strength (*Powerful))
                   (fuel     ((a Gas with (combustibility (*Hi)))))))))

(Car has (superclasses (Vehicle)))

(every Car has
  (has-engine ((a Engine with
                  (size (*Average))
                  (fuel ((a Gas with (type (*Unleaded)))))))))

(showme (the has-engine of (a Car)))

(showme (the fuel of (thelast Engine)))

(showme (thelast Engine))

((a Pet with (color (*Green))) & (a Fish with (size (*Small))))

(showme (thelast Pet))

;;; (*Red & *Green)  ; should fail

(a Color)

((thelast Color) & *Red)

(thelast Color)

;;; ----------------------------------------

(every Person has
  (owns ((a Car))))

(Professor has (superclasses (Person)))

(every Professor has
  (owns ((a Car))))

((Cat Dog) && (Dog Elephant))

((Cat) && (Cat))

(color has 
 (instance-of (Slot)) 
 (cardinality (N-to-1)))      ; for demo, items have unique color

(((a Cat with (color (*Red)))) && ((a Cat with (color (*Blue)))))

(the color of (thelast Cat))

;;; ----------------------------------------

(every Animal has 
  (parts ((a Head) 
  (a Body with (covering (*Skin))))))

(Mammal has (superclasses (Animal)))

(every Mammal has
  (parts ((a Leg) (a Leg) (a Leg) (a Leg))))

(Dog has (superclasses (Mammal)))

(every Dog has 
  (parts ((a Tail) (a Body with (covering (*Skin *Fur))))))

(the parts of (a Dog))

(showme (thelast Body))

(the covering of (thelast Body))

;;; ----------
(Square has 
	(superclasses (Rectangle)))	; most specific superclass

(every Square has-definition	; `Definitional' properties
	  (instance-of (Shape))		; most general superclass
          (width ((Self length)))
          (length ((Self width))))

(every Square has			; `Incidental' properties
          (appearance (*Pretty)))

(Rectangle has (superclasses (Shape)))

((the appearance of (a Rectangle with (width (10)) (length (10)))) = *Pretty)

;;; ----------------------------------------

;;; Undo previous inverse declaration for parts:
(parts has 
   (instance-of (Slot))
   (inverse (parts-of)))

(Nissan-Wheel has
  (superclasses (Wheel)))

(every Nissan-Wheel has-definition
  (instance-of (Wheel))
  (parts-of ((a Nissan))))

(every Nissan-Wheel has
  (cost (100)))

;;; ----------

(every Nissan has 
  (parts ((a Wheel) (a Wheel) (a Wheel) (a Wheel))))

(Nissan has (superclasses (Car)))

(the parts of (a Nissan))

; (the sum of (the cost of (the Wheel parts of (a Nissan))))
(the sum of (the cost of (the bag of (the Wheel parts of (a Nissan)))))

;;; ----------

(every Smoker has-definition
   (instance-of (Person))
   (smokes (t)))

(every Smoker has
   (life-expectancy (70)))

(every Non-Smoker has-definition
   (instance-of (Person))
   (smokes (f)))

(every Non-Smoker has
   (life-expectancy (75)))

(the life-expectancy of (a Person with (smokes (t))))

(the life-expectancy of (a Person with (smokes (f))))

;;; ----------------------------------------

(*London has-definition
      (instance-of (City))		; most general class
      (capital-of (*UK)))

(*London has
     (instance-of (Big-City))		; most specific class
     (population (10000000)))

(Big-City has (superclasses (City)))

(the population of (a City with (capital-of (*UK))))

; ----------

(*USA has 
        (instance-of (Country)) 
        (cities (*Seattle *Austin)))             ; just use two cities for now!

(*Seattle has 
        (instance-of (City)) 
        (mean-temp (50)))

(*Austin has 
        (instance-of (City)) 
        (mean-temp (90)))

(the max of (the mean-temp of (the cities of *USA))) ; hottest temp


(*USA cities * mean-temp * max)                     ; equivalent `linear' notation

((allof (the cities of *USA)                        ; the hottest city(s)
     where ((the mean-temp of It) = 
        (the max of (the mean-temp of (the cities of *USA)))))
 = *Austin)

((allof ?x in (the cities of *USA)                        ; the hottest city(s)
     where ((the mean-temp of ?x) = 
        (the max of (the mean-temp of (the cities of *USA)))))
 = *Austin)

; ----------

(reset-kb)

(Vehicle has (superclasses (Thing)))

(Car has (superclasses (Vehicle)))

(every Car has
  (parts ((a Wheel) (a Wheel) (a Wheel) (a Wheel) (a Engine) (a Chassis))))

(the number of (the Wheel parts of (a Car)))

(Car has (superclasses (Vehicle)))

(every Car has
  (parts ((a Wheel) (a Wheel) (a Wheel) (a Wheel) (a Engine) (a Chassis)))
  (wheel-count ((the number of (the Wheel parts of Self)))))

(every Wheel has
 (weight (1)))

(every Engine has
  (weight (20)))

(every Chassis has
  (weight (10)))

;(the sum of (the weight of (the parts of (a Car))))
(the sum of (the weight of (the bag of (the parts of (a Car)))))

(weight has
  (instance-of (Slot))
  (cardinality (N-to-1))); ie. weight is a single-valued slot

(every Physobj has
;  (weight ((the sum of (the weight of (the parts of Self)))))
  (weight ((the sum of (the bag of (the weight of (the parts of Self)))))))

(Vehicle has (superclasses (Physobj)))

(the weight of (a Car))

(2 * 2)

(reset-kb)

 (*Bruce has
        (instance-of (Person))
        (vehicle ((a Car with (color (*Brown)) (age (*Old)))
                  (a Car with (color (*Red))   (age (*New)))
                  (a Van with (color (*Red))   (age (*Old))))))

 (Car has (superclasses (Passenger-Vehicle)))
 (Van has (superclasses (Passenger-Vehicle)))
 (*Red has (instance-of (Bright-Color)))
 (*Brown has (instance-of (Dark-Color)))

 (the vehicle of *Bruce)

 ((the Van vehicle of *Bruce) is '(a Passenger-Vehicle with (color ((a Bright-Color)))))

; ((the vehicle of *Bruce) are (a Passenger-Vehicle)); OLD

(allof (the vehicle of *Bruce)			     ; NEW - Version 1
  must (It is '(a Passenger-Vehicle)))

(Passenger-Vehicle subsumes (the vehicle of *Bruce)) ; NEW - version 2

; ((the vehicle of *Bruce) includes (a Car with (color ((a Bright-Color)))))   OLD
(has-value (oneof (the vehicle of *Bruce) 
	    where (It is '(a Car with (color ((a Bright-Color)))))))  ; NEW

(the Car with 
       (vehicle-of (*Bruce)) 
       (color (*Brown)))

(the color of (thelast Car))

(the Person with
       (vehicle ((a Van with 
                     (color (*Red))))))

(every Person with
       (vehicle ((a Van with 
                     (color (*Red))))))

 (every Passenger-Vehicle with 
        (vehicle-of (*Bruce)) 
        (color (*Red)))

(the+ Car with (vehicle-of (*Bruce)) (color (*Red)))

(the+ Car with (vehicle-of (*Bruce)) (color (*Blue)))

(showme *Bruce)

;;; ----------

(every Journey has
  (time-taken (((Self distance) / (Self speed))))
  (speed ((the typical-speed of (the owned-vehicle of Self))))
  (distance ((the abs of ((Self from * position) - (Self to * position))))))

(*Seattle has
  (instance-of (Place))
  (position (100)))

(*Boston has
  (instance-of (Place))
  (position (3000)))

(Nissan has (superclasses (Car)))

(every Nissan has (typical-speed (55.0)))

(Porsche has (superclasses (car)))

(every Porsche has (typical-speed (90.0)))

(the time-taken of (a Journey with 
(from (*Seattle)) 
(to (*Boston)) 
(owned-vehicle ((a Nissan)))))

(the time-taken of (a Journey with 
(from (*Seattle)) 
(to (*Boston)) 
(owned-vehicle ((a Porsche)))))

(*Seattle has
  (instance-of (Place))
  (position ((a Coordinate with
(lat (100))
(lng (234))))))

;;; ----------------------------------------
;;; "If the car is domestic then spare parts will be cheap, 
;;;  otherwise they'll be expensive."
(every Car has
  (cost-of-parts (
(if    ((Self made-by * location) = (Self owner Person lives-in))
 then  *Low
 else  *High))))

(Sentra has (superclasses (Car)))

(every Sentra has (made-by (*Nissan)))

(Geo-Metro has (superclasses (Car)))

(every Geo-metro has (made-by (*Chrysler)))

(*Nissan has
  (instance-of (Manufacturer))
  (location (*Japan)))

(*Chrysler has
  (instance-of (Manufacturer))
  (location (*USA)))

(a Sentra with (owner ((a Person with (lives-in (*USA))))))

(the cost-of-parts of (thelast Sentra))

(a Person with 
(lives-in (*USA))
(owned-vehicle (Sentra)))

(owned-vehicle has
       (instance-of (Slot))
       (domain (Person))
       (range (Vehicle))
       (inverse (owner))
       (cardinality (1-to-N)))

 (a Person with 
(lives-in (*USA))
(owned-vehicle (Sentra)))

(the owned-vehicle of (thelast Person))

(showme (thelast Sentra))

(the cost-of-parts of (thelast Sentra))

(every Tree has
  (parts ((a Root-system))))

(every Root-system has
  (feeds ((Self parts-of Tree))))

(a Tree)

;; "What does the tree's root-system parts feed?"
((thelast Tree) parts Root-system feeds)

;;; ----------------------------------------
;;; "A Car's engine turns the front wheels."
(every Car has
  (parts ((a Wheel with (position (*Front)) (side (*Left)))
  (a Wheel with (position (*Front)) (side (*Right)))
  (a Wheel with (position (*Back)) (side (*Left)))
  (a Wheel with (position (*Back)) (side (*Right)))
  (a Chassis)
  (Self has-engine)))
  (has-engine ((a Engine with
                  (powers-wheels ((allof (the Wheel parts of Self)
                                   where ((the position of It) = *Front))))))))

; "Which wheels does a car's engine turn?"
((a Car) parts Engine powers-wheels Wheel)

;;; Has two powered wheels
((the number of (allof (the Wheel parts of (a Car))
     where ((the position of It) = *Front)))
 = 2)

((forall (the Wheel parts of (a Car))
      where ((the position of It) = *Front) 
            (the side of It)) = (:set *Left *Right))

((forall ?x in (the Wheel parts of (a Car))
      where ((the position of ?x) = *Front) 
            (the side of ?x)) = (:set *Left *Right))

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

(reset-kb)

(every Airplane has
  (speed (300))
  (the-range (1000))
  (cost-per-mile (1)))

(every Car has
  (speed (60))
  (the-range (300))
  (cost-per-mile (0.01)))

(every Bicycle has
  (speed (20))
  (the-range (20))
  (cost-per-mile (0)))

(a Journey with 
(distance (100))
(max-travel-time (2)))

;; "Find which modes of transport have enough range and are
;;  fast enough for my journey..."
(oneof ?x in (allof  (:set (a Airplane) (a Car) (a Bicycle))
     where  (    ((the the-range of It) >= (the distance of (thelast Journey)))
             and (((the distance of (thelast Journey)) / (the speed of It)) 
                        <= (the max-travel-time of (thelast Journey)))))
 where (?x isa Airplane))
; includes (a Airplane))		; check I get the right answer
; covers '(a Airplane))		; NEW

(every Journey has
  (possible-modes-of-transport (                ;; repeat the above expression
     (allof (:set (a Airplane) (a Car) (a Bicycle))
      where  (    ((the the-range of It) >= (the distance of Self))
              and (((the distance of Self) / (the speed of It)) 
                        < (the max-travel-time of Self))))))
  (cheapest-mode-of-transport (
    (allof (the possible-modes-of-transport of Self)
     where (  (the cost-per-mile of It) 
            = (the min of (the cost-per-mile of
		(the bag of (the possible-modes-of-transport of Self)))))))))

((the cheapest-mode-of-transport of
	(a Journey with (distance (10))
			(max-travel-time (1))))
 isa Bicycle)

((the cheapest-mode-of-transport of
	(a Journey with (distance (300))
			(max-travel-time (10))))
 isa Car)

((the cheapest-mode-of-transport of
	(a Journey with (distance (300))
			(max-travel-time (2))))
 isa Airplane)

;;; ----------

(*Pete has
       (instance-of (Person))
       (likes (*Sue *Sue)))

(*Pete likes)

(*Pete has
       (instance-of (Person))
       (parts ((a Leg) (a Leg))))       ; NB *not* duplicate instances!

(the parts of *Pete)

;;; ----------

(*Pete has (salary (100)))

(*Joe  has (salary (100)))

(*Mycompany has 
       (instance-of (Company))
       (employees (*Pete *Joe)))

(every Company has 
	(salaries ((the salary of (the bag of (the employees of Self)))))
	(total-payroll ((the sum of (the salaries of Self)))))

((the total-payroll of *Mycompany) = 200)

(*Pete has (salary ((a MoneyUnit with (magnitude (100)) (units (*dollar))))))

(*Joe  has (salary ((a MoneyUnit with (magnitude (100)) (units (*dollar))))))

(100 = 100)

;;; ----------------------------------------

(every Square has
  (length ((Self width)))
  (width  ((Self length))))

;;; ----------------------------------------

(reset-kb)

(every Physobj has
  (parts ((Self d-parts) (Self d-parts * parts))))

(Car has (superclasses (Physobj)))

(every Car has (d-parts ((a Engine) (a Chassis) (a Body))))

(Engine has (superclasses (Physobj)))

(every Engine has 
    (d-parts ((a Carburetor) (a Battery) (a Combustion-chamber))))

(Body has (superclasses (Physobj)))

(every Body has 
  (d-parts ((a Door) (a Door) (a Frame) (a Windshield))))

(Door has (superclasses (Physobj)))

(every Door has
  (d-parts ((a Handle) (a Window) (a Panel))))

(every Physobj has
          (parts ((the d-parts of Self)
		  (the parts of (the d-parts of Self))))
          (leaf-parts ((allof (the parts of Self) 			; [1]
			 where (not (the d-parts of It))))))		; [2]

;;; Check all the leaf parts are there!
((the number of (the leaf-parts of (a Car))) = 12)

((the number of (the parts of (a Car))) = 16)

;;; ----------------------------------------

(Vehicle has (superclasses (Physobj)))

(every Vehicle has
  (body-parts ((a Frame) (a Fender)))
  (parts ((a Steering-wheel))))

(Car has (superclasses (Vehicle)))

(every Car has
  (mechanical-parts ((a Engine)))
  (body-parts ((a Frame))))

;;; SLOT HIERARCHY:
;;;   parts
;;;  /     \
;;; body-parts    mechanical-parts
(parts has 
  (instance-of (Slot))
  (subslots (mechanical-parts body-parts)))

(the parts of (a Car))

;;; ----------------------------------------

(likes has
  (instance-of (Slot))
  (inverse (liked-by)))

(every Professor has      ; all professors...
   (spouse ((a Person with (pets ((a Dog))))))    ; ...have a spouse with a dog
   (likes ((the pets of (the spouse of Self)))))  ; ...and like that dog.

(*Fred has (instance-of (Professor)))  ; Fred is a professor

(the pets of (the spouse of *Fred))    

(*Fred likes)

((thelast Dog) liked-by)     ; ...thus the query now succeeds.

;;; ----------------------------------------

(every Professor has
      (spouse ((a Person with
   (pets ((a Dog with 
       (liked-by (Self))))))))  ; `liked-by' defined
      (likes ((the pets of (the spouse of Self)))))     ; `likes' defined

(*Joe has (instance-of (Professor)))

(the pets of (the spouse of *Joe))     

((thelast Dog) liked-by)

;;; ----------

#|
Now superceded by :seq operation

(rota has
	(instance-of (Slot))
	(duplicate-valued (t)))

(My-Coffee-Club has
       (rota (Pete Joe Pete Joe Pete)))

((the number of (the rota of My-Coffee-Club)) = 5)

((the number of (remove-dups (the rota of My-Coffee-Club))) = 2)
|#

;;; ----------------------------------------

(reset-kb)

(length has 
  (instance-of (Slot))
  (cardinality (N-to-1)))

(width has 
  (instance-of (Slot))
  (cardinality (N-to-1)))

(every Square has
  (length ((a Number)))
  (width ((Self length))))

(the width of (a Square with (length (1))))

(the length of (a Square with (width (1))))

(a Square with (width (1)))

(the length of (thelast Square))

(the width of (thelast Square))

(the length of (thelast Square))

(every Square has
  (length ((Self width)))
  (width  ((Self length))))

;;; ----------------------------------------

(a House)

(the name of *Pete)

(Remove has (superclasses (Activity)))

(every Remove has
  (text ("Remove" (Self object) "from" (Self location) ".")))

(the text of (a Remove with 
		(object ((a Sample)))
		(location ((a Box)))))

(make-sentence (the text of (a Remove with 
		(object ((a Sample)))
		(location ((a Box))))))

;;; ----------------------------------------

(Remove has (superclasses (Activity)))

(every Remove has
  (text ("Remove" (Self object) "from" (Self location) ".")))

(every Electrophoresis has
  (sample ((a Chemical)))
  (equipment ((a Separation-unit) (a Syringe)))
  (first-task (
    (a Remove with
	(object ((Self sample)))
	(location ((Self sample * delivery-medium)))))))

(Albumin has (superclasses (Chemical)))

(every Albumin has
  (delivery-medium ((a Bottle))))

(the text of (the first-task of (a Electrophoresis with 
	(sample ((a Albumin))))))

(make-sentence (the text of (the first-task of (a Electrophoresis 
	with (sample ((a Albumin)))))))

;;; ==================================================================
;;;                       START OF DEMO KB
;;; ==================================================================

(reset-kb)

(every Electrophoresis has
  (sample ((a Chemical)))
  (equipment ((a Separation-unit) (a Syringe)))
  (subevents (
    (a Remove with
        (object ((the sample of Self)))
        (location ((the delivery-medium of (the sample of Self)))))
    (a Insert with
        (object ((the sample of Self)))
        (destination ((the Separation-unit equipment of Self)))
        (equipment ((the Syringe equipment of Self))))
    (if   ((the density of (the sample of Self)) >= 3)
     then ((a Add with
                (object ((a Dilutant)))
                (destination ((the Separation-unit equipment of Self))))))
    (a Wait with
        (duration ((the floor of ((the density of (the sample of Self)) * 30))))
        (units (*Seconds)))
    (a Remove with
        (object ((the sample of Self)))
        (location ((the Separation-unit equipment of Self))))
    (a Store with 
        (object ((the sample of Self)))
        (destination ((the storage-medium of (the sample of Self))))))))

;;; ----------

(Remove has (superclasses (Activity)))
(every Remove has
  (text ((:seq "Remove" (the object of Self) "from" (the location of Self)))))

(Insert has (superclasses (Activity)))
(every Insert has
  (text ((:seq "Insert" (the object of Self) "into" (the destination of Self) 
                "using" (Self equipment)))))

(Add has (superclasses (Activity)))
(every Add has
  (text ((:seq "Add" (the object of Self) "to" (the destination of Self)))))

(Wait has (superclasses (Activity)))
(every Wait has
  (text ((:seq "Wait" (the duration of Self) (the units of Self)))))

(Store has (superclasses (Activity)))
(every Store has
  (text ((:seq "Store" (the object of Self) "in" (the destination of Self)))))

;;; ----------
(Albumin has (superclasses (Chemical)))
(every Albumin has
  (density (1.2))
  (delivery-medium ((a Bottle)))
  (storage-medium ((a Fridge))))

(Endoprotein has (superclasses (Chemical)))
(every Endoprotein has
  (density (4.2))
  (delivery-medium ((a Box)))
  (storage-medium ((a Vacuum-flask))))

;;; ======================= END ==============================

(forall (the subevents of (a Electrophoresis with (sample ((a Albumin)))))
            (make-sentence (the text of It)))

(forall (the subevents of (a Electrophoresis with (sample ((a Endoprotein)))))
            (make-sentence (the text of It)))

(SETQ *LINEAR-PATHS* NIL)(print "refman.km")

(SETQ *LINEAR-PATHS* T)

(reset-kb)

*Pete

34

Car

(a Car)

(an instance of Car)               ; equivalent

(a Car with (color (*Red)))

 (a Car with (color (*Blue)) (parts ((a Engine))))

 (showme (thelast Car))

(Car has (superclasses (Vehicle)))        ; Property of class Car

(every Car has                            ; Property of members of class Car
        (wheels (4)))

(Car has (superclasses (Vehicle)))

(every Car has (wheels (4)))

(showme Car)

(every Car has 
        (parts ((a Engine with (fuel-type (*Gasoline))))))

(every Car-maker has (product-type (Car)))

(*Pete has
        (owns ((an instance of (the product-type of (a Car-maker))))))

(the owns of *Pete)        ; generate an instance of the product-type

(a Car with (color (*White)))              

(thelast Car)                            ; the most recent car

(show-obj-stack)                     ; display the entire stack

(every Car has (parts ((a Hood) (a Engine with (fuel-type (*Gasoline))))))

((a Car) parts)                    ; create a car and find its parts

((a Car) parts Hood)               ; just the hood parts 

((a Car) parts Engine fuel-type)

((a Car) parts * fuel-type)        ; * is a wild-card

(the parts of (a Car))             ; alternative syntax
 
(the Hood parts of (a Car))         ; select just parts of type hood

(the fuel-type of (the Engine parts of (a Car)))   ; alternative syntax

(a Person with (parts ((a Leg) (a Leg))))       ; a two-legged person

(the Leg parts of (thelast Person))

(the first of (the Leg parts of (thelast Person)))  ; 'first' is a special slot

(the second of (the Leg parts of (thelast Person)))

(every Person has (parts ((a Head) (a Leg) (a Leg))))

(the parts of (a Person))

(showme (thelast Head))

((thelast Head) parts-of)                  ; Can see who _head151 belongs to

(*UT-net has 
        (instance-of (Network))
        (servers ((a Server) (a Server) (a Server))))

(*UT-net servers)

((thelast Server) servers-of)      ; Similarly, can find the network of _server154

(loves has
      (instance-of (Slot))
      (inverse (loved-by)))

(every Person has (loves ((Self pets))))

(*Fred has
      (instance-of (Person))
      (pets ((a Dog))))

(*Fred loves)

((thelast Dog) loved-by)          ; shows inverse was automatically installed

;;; ----------------------------------------
;;;		SUBSUMPTION
;;; ----------------------------------------

(reset-kb)

 (Airplane has (superclasses (Vehicle)))
 (every Airplane has 
        (parts ((a Engine with (connects-to ((a Heater)
                                             (a Pump with (size (*Big))))))
                (a Engine with (connects-to ((a Pump with (size (*Small)))))))))

 (*Airplane1 has (instance-of (Airplane)))

; (*Airplane1 is (a Vehicle with (parts ((a Engine)))))  ; OLD
(*Airplane1 is '(a Vehicle with (parts ((a Engine)))))  ; NEW (quote ' added)

; ((the parts of *Airplane1) are (a Engine with (connects-to ((a Pump))))) ; OLD
('(every Engine with (connects-to ((a Pump)))) subsumes (the parts of *Airplane1))  ; NEW

; ((the parts of *Airplane1) includes (a Engine with (connects-to ((a Heater))))) ; OLD
; ((the parts of *Airplane1) covers '(a Engine with (connects-to ((a Heater))))) ; NEW

;;; "The engine connected to the heater"
 (the Engine with
        (parts-of (*Airplane1))
        (connects-to ((a Heater))))

;;; "The engine connected to the big pump"
 (the Engine with
        (parts-of (*Airplane1))
        (connects-to ((a Pump with
                          (size (*Small))))))

 (the parts of *Airplane1)

;;; ----------
(the+ Car with (color (Red)))

(the+ Car with (color (Red)))

(Red has (instance-of (Bright-Color)))

(the+ Car with (color ((a Bright-Color))))

;;; ----------

(every Person has 
          (happiness ((if (Self owns Chocolate) then *Hi else *Lo))))

(the happiness of (a Person with (owns ((a Chocolate)))))

(the happiness of (a Person)) ; a different person (NB closed-world assumption)

;;; ----------------------------------------

;;; ----------------------------------------------------------------------

(every Tourist has
       (carries ((if (((the restricted-countries of (the visited-country of Self)))
                      includes (Self nationality))
                  then ((a Visa with (stamp ((Self visited-country)))))))))

(*USA has 
       (instance-of (Country)) 
       (restricted-countries (*Cuba *Korea *China)))

(the carries of (a Tourist with (nationality (*Cuba))
                                    (visited-country (*USA))))

(the stamp of (thelast Visa))    ; The Cuban tourist needs a USA visa to visit USA

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

(reset-kb)

 (*Porter has
        (owns ((a Car with (color (*Brown)) (age (*Old)))
               (a Car with (color (*Red))   (age (*New)))
               (a Van with (color (*Red))   (age (*Old))))))

 (allof (the owns of *Porter)
     where ((the color of It) = *Red))       ; all Porter's red things

 (oneof (the owns of *Porter)
     where ((the color of It) = *Red))       ; one of Porter's red things

(forall (the owns of *Porter)            ; the age(s) of all Porter's red things
      where ((the color of It) = *Red) 
            (the age of It))

; no longer used
; (forone (the owns of *Porter)            ; the age(s) of one of Porter's red things
;      where ((the color of It) = *Red) 
;            (the age of It))

 (allof (the owns of *Porter)             ; Porter's van(s)
     where (It isa Van)) 

 (the Van owns of *Porter)                ; Porter's van(s) (alternative formulation)

 (allof (the owns of *Porter)             ; Porter's new car(s)
     where ((It isa Car) and ((the age of It) = *New)))

((the color of (allof (the owns of *Porter)   ; The color(s) of Porter's new car(s)
            where ((It isa Car) and ((the age of It) = *New)))) = *Red)

(*Red has (instance-of (Pretty-color)))

((the number of
  (allof (the owns of *Porter)            ; all of Porter's pretty-colored things
     where ((the color of It) isa Pretty-color))) = 2)

;;; ----------
#|
The following forms need to be tested:
1     (#$allof ?var #$in  ?set #$where ?test)	
2     (#$allof ?var #$in ?set #$must ?test)	
3     (#$allof ?var #$in ?set #$where ?test2 #$must ?test)	
4     (#$oneof ?var #$in ?set #$where ?test)	
5     (#$theoneof ?var #$in ?set #$where ?test)	
6     (#$forall ?var #$in ?set ?value)
7     (#$forall-seq ?var #$in ?seq ?value)
8     (#$forall-bag ?var #$in ?bag ?value)
9     (#$forall ?var #$in ?set #$where ?constraint ?value)
10    (#$forall-bag ?var #$in ?bag #$where ?constraint ?value)
11    (#$forall-seq ?var #$in ?seq #$where ?constraint ?value)
|#


(allof ?x in (the owns of *Porter) where ((the color of ?x) = *Red))       ; 1. all Porter's red things
(allof ?x in (the owns of *Porter)  where (?x isa Van))            	   ; 1. Porter's van(s)
(oneof ?x in (the owns of *Porter) where ((the color of ?x) = *Red))       ; 4. one of Porter's red things
(theoneof ?x in (the owns of *Porter) where ((?x isa Van)))		   ; 5.
(forall ?x in (the owns of *Porter)     			           ; 9. the age(s) of all Porter's red things
      where ((the color of ?x) = *Red) 
            (the age of ?x))

((forall-seq ?x in (:seq 1 2 3 3) (?x + 1)) 				   ; 7
	= (:seq 2 3 4 4))

((forall-seq ?x in (:seq 1 2 3 3) where (?x >= 2) (?x + 1))		   ; 11
	= (:seq 3 4 4))

((forall-bag ?x in (:bag 1 2 3 3) (?x + 1)) 				   ; 8
	= (:bag 2 3 4 4))

((forall-bag ?x in (:bag 1 2 3 3) where (?x >= 2) (?x + 1))		   ; 10
	= (:bag 3 4 4))

(allof ?x in (:set 1 2 3) must (?x > 0))				   ; 2
(allof ?x in (:set 1 2 3 4 5 6 7 8 9 10) where (?x > 5) must (?x > 5))	   ; 3
 ((forall ?x in (:set 1 2 3) (?x * 2)) = (:set 2 4 6))			   ; 6

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

(reset-kb)

(every Person has 
       (favorite-clothes ((allof (the clothes of Self)
                           where ((the color of It) = 
                                        (the favorite-color of Self))))))
 (*Pete has
        (instance-of (Person))
        (favorite-color (*Black))
        (clothes ((a T-shirt with 
                        (color (*Black)) (cost (40)) (brand (*Levi)))
                  (a Hat with 
                        (color (*Pink))  (cost (10)) (brand (*Bambi)))
                  (a Sweater with 
                        (color (*Black)) (cost (20)) (brand (*Joeblo))))))


 (the favorite-clothes of *Pete)

;;; "A person's favorite brands are those of his cheap, favorite clothes."
 (every Person has 
       (favorite-brands ((forall (the favorite-clothes of Self)
                           where ((the cost of It) < 30)
                                 (the brand of It)))))

( (the favorite-brands of *Pete) = *Joeblo)

(reset-kb)

(a Network with (servers ((a Server) (a Server) (a Server))))

(servers has 
        (instance-of (Slot))
        (inverse (networked-to)))	    ; declare servers/networked-to as inverses

 (the servers of (thelast Network))

;;; "A server will poll all the other servers in it's network."
;;; Note: in (Self agent Server servers-of Network servers), servers-of is
;;;    the automatically installed inverse of servers.
;;;    Thus (Self agent Server servers-of Network) finds the polling server's network, 
;;;    and from there we can find all the servers in that network.
 (every Poll-event has 
        (agent  ((a Server)))
        (polled ((allof (the servers of 			; the servers...
				(the networked-to of 		; on the network of...
					(the agent of Self)))   ; the agent in this event..
                  where  (It /= (the agent of Self))))))	; except that agent itself.

;;; "Which server(s) does _Server114 poll?"
((the number of (the polled of (a Poll-event with (agent ((thelast Server)))))) = 2)

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

(*Joe has 
        (instance-of (Person))
        (beliefs ((a Triple with
                        (frame (*Fred))
                        (slot (loves))
                        (value (*Sue))))))

(the beliefs of *Joe)

(*Pete has (belief ((:triple *John owns (a Car)))))

(the belief of *Pete)

; No longer supported
;(the frame of (the belief of *Pete))
;(the slot of (the belief of *Pete))
;(the value of (the belief of *Pete))

(new-situation)

(every Putting has
	  (object ((a Thing)))
	  (destination ((a Box)))
	  (add-list ((:triple (the destination of Self) contents (the object of Self)))))

(the add-list of (a Putting with (object ((a Block))) (destination ((a Box)))))

;;; No longer supported
;(the frame of (the first of (the add-list of (thelast Putting))))
;(the slot of (the first of (the add-list of (thelast Putting))))
;(the value of (the first of (the add-list of (thelast Putting))))

(reset-kb)

(1 + 2)

(1 + 2 + 3)

;(the sum of (:set 1 2))
(the sum of (:bag 1 2))

; no longer supported
;(the difference of (:set 100 10 1))

(the number of (:set 100 10 1))  ; set cardinality

(every Car has (cost (10000)))
(every Dog has (cost (100)))
(every Book has (cost (10)))
(a Person with (possessions ((a Car) (a Dog) (a Book))))

(the possessions of (thelast Person))

(the number of (the possessions of (thelast Person)))

((thelast Person) possessions Thing number) ; KM-style path

;(the sum of (the cost of (the possessions of (thelast Person))))
(the sum of (the cost of (the bag of (the possessions of (thelast Person)))))

(every Thing has (cost ((a Number))))

(the sum of (:bag (the cost of (a Car)) 
                      (the cost of (a Book))))

(the sum of (:bag (the cost of (a Car)) 
                      (the cost of (a Elephant))))

;;; ----------------------------------------
;;;	aggregation slots:
;;; ----------------------------------------

(mysum has 
	(instance-of (Set-Aggregation-Slot)) 
	(aggregation-function ('#'(LAMBDA (VALS) (APPLY #'+ VALS)))))

((the mysum of (:set 1 2 3)) = 6)

;;; ----------------------------------------

((a Pet with (color (*Green))) & (a Fish with (size (*Small))))

(((a Cat) (a Dog)) && ((a Dog) (a Elephant)))   ; ie. {cat dog} && {dog elephant}

(((a Cat)) && ((a Cat)))

;;; ------------------------------

(every Mexican has-definition
       (instance-of (Person))			; most general superclass
       (lives-in (*Mexico)))

(Mexican has 
       (superclasses (North-American)))		; most specific superclass

(every Mexican has
       (temperament (*Cheerful)))

 (the temperament of (a Person with (lives-in (*Mexico))))

(*UK has-definition
        (instance-of (Country))
        (capital (*London)))

(*UK has
        (country-name ("the United Kingdom")))

(the country-name of (a Country with (capital (*London))))

;;; ------------------------------

(reset-kb)

(every Send has                    ; the "text" slot contains a template
        (text ((:seq (Self agent) "sends" (Self object) "to" (Self recipient)))))
        
(a Send with 
       (agent ((a Professor)))
       (object ((a Letter)))
       (recipient (*Joe)))

(the text of (thelast Send))

(make-sentence (the text of (thelast Send)))

(every Hole has
	(text ((:seq "a hole with depth" (Self depth) "nospace" "cm"))))

(make-sentence (the text of (a Hole with (depth (43)))))

(reset-kb)

(every Send has
       (text ((:seq "Send" (andify (Self objects)) "to" (Self destination)))))

((make-sentence (the text of (a Send with 
                                (objects ((a Box) (a Cat) (a Dog))) 
                                (destination (*London)))))
 = "Send the box, the cat, and the dog to london.")

;(every Group has
;	  (name ((make-phrase (:seq "a group of" (pluralize (the name of (Self member-type))))))))

(every Group has
	  (name ((:seq "a group of" (Self member-type) "nospace" "s"))))

(MyBooks has
	  (instance-of (Group))
	  (member-type (Book)))

((make-phrase (the name of MyBooks)) = "a group of books")

;;; ======================================================================
;;;		SITUATIONS
;;; ======================================================================

(reset-kb)

(Action has (superclasses (Event)))
(Putting has (superclasses (Action)))

(every Putting has
      (object ((a Thing)))
      (destination ((a Container)))
      (add-list ((:triple (the destination of Self) contents (the object of Self)))))

 (*My-Box has (instance-of (Container)))             ; Create a box...

 (*BlockA has (instance-of (Block)))                 ; and two blocks...

 (*BlockB has (instance-of (Block)))

(Situation1 has (instance-of (Situation)))

(in-situation Situation1)

(do-and-next (a Putting with          ; Put *BlockA in...
                                    (object (*BlockA))              
                                    (destination (*My-Box))))

 (the contents of *My-Box)           ; What is now in the box?

(curr-situation)			; Which situation am I in?

(global-situation)			; Return to the global KB

;;; "What was in *My-Box at the start?"
(not (in-situation Situation1 (the contents of *My-Box)))

;;; "What was in *My-Box at the end?"
((in-situation (the next-situation of Situation1) (the contents of *My-Box)) = *BlockA)

(SETQ *LINEAR-PATHS* NIL)(print "situations.km")

;;; Test suite for new situations manual...

(reset-kb)

(*Joe has                                           ; Global KB assertion
        (instance-of (Person))                          ; (visible to all Situations)
        (birthdate (1963)))

(S == (a Situation))

(in-situation S)

((the birthdate of *Joe) = 1963)               ; Global facts are visible

(*Joe has (mood (*Happy)))            ; Make a local assertion

((the mood of *Joe) = *Happy)

; (in-situation *Global)

; (not (the mood of *Joe))                                  ; Local assertions are not

(S2 == (a Situation))

(in-situation S2)

(*Joe has (mood (*Sad)))              ; Alternative assertion

((the mood of *Joe) = *Sad)

(in-situation *Global)

(new-situation)
(curr-situation)
(global-situation)

(in-situation S ((the mood of *Joe) = *Happy))
(in-situation S2 ((the mood of *Joe) = *Sad))

((oneof (the all-instances of Situation)
     where (in-situation It ((the mood of *Joe) = *Happy))) = S)

;;; ----------

(every Person has
      (year-of-birth ((a Number)))                                 ; (in years)
      (age (((the year of *Todays-Date) - (the year-of-birth of Self)))))

(*Fred has
      (instance-of (Person))
      (year-of-birth (1963)))

(new-situation)

(*Todays-Date has
                      (year (2000)))

((the year-of-birth of *Fred) = 1963)
((the age of *Fred) = 37)

(year-of-birth has
       (instance-of (Slot))
       (fluent-status (*Non-Fluent)))

;;; --------------------

(a Situation with
       (date (4-20-00))
       (time (*Morning)))

(*Petes-Thursday-Morning has
        (instance-of (Situation))
        (date (4-20-00))
        (time (*Morning)))

(in-situation *Petes-Thursday-Morning)

 (*Pete has
                                (location ((a Chair with 
                                              (in-front-of ((a Computer)))))))

(global-situation)

(*Petes-Thursday-Morning has
       (main-participant (*Pete)))

(S4 == (a Situation with
      (main-participant ((a Person)))))

(in-situation S4
        ((the main-participant of S4) has (location ((a Chair)))))

(S4b == (a Situation with
          (main-participant ((a Person)))
          (assertions ('((the main-participant of #,Self) has (location ((a Chair))))))))

(in-situation S4 ((the location of (the main-participant of S4)) isa Chair))
(in-situation S4b ((the location of (the main-participant of S4b)) isa Chair))

;;; ----------

(Falling-Situation has (superclasses (Situation)))

(every Falling-Situation has
      (agent ((a Person))))

(in-every-situation Falling-Situation
        ((the agent of TheSituation) has (feelings (*Scared))))

;;; This is the internal representation, which the above generates. Note the #, unquoting is needed now.
(every Falling-Situation2 has
       (assertions ('((the agent of #,Self) has (feelings (*Scared))))))

(*Pete has (instance-of (Person)))

(FS == (a Falling-Situation with (agent (*Pete))))
(in-situation FS ((the feelings of *Pete) = *Scared))

(FS2 == (a Falling-Situation with (agent (*Pete))))
(in-situation FS2 ((the feelings of *Pete) = *Scared))

;;; ----------

(:triple *Pete state *Happy)

(every Person has
      (belief ((:triple Self state *Happy))))

(reset-kb)

(every Person has
      (belief ((forall (the has-pets of Self)
                       (:triple It state *Happy)))))

((the belief of (a Person with (has-pets (*Fido)))) = (:triple *Fido state *Happy))

;;; ----------

(every Person has
      (belief ((:triple (the house-lived-in of Self) appearance *Beautiful))))

;To do ...
;(not (is-true (:triple *Pete state *Happy)))

;(assert (:triple *Pete state *Happy))
;
;(is-true (:triple *Pete state *Happy))
;
;((the state of *Pete) = *Happy)

;;; ----------

(Switching-On has (superclasses (Action)))

(every Switching-On has
  (object ((a Switch)))
  (pcs-list ((:triple (the object of Self) position *Down)))
  (del-list ((:triple (the object of Self) position *Down)))
  (add-list ((:triple (the object of Self) position *Up))))

;;; ----------
;;; This should become built-in:

(_Situation01 has (instance-of (Situation)))
(_Situation02 has (instance-of (Situation)))

(_Situation01 has
      (next-situation ((:args _Situation02 _Action01))))

((the next-situation of _Situation01) = (:args _Situation02 _Action01))

((the before-situation of _Action01) = (:args _Situation01 _Situation02))

((the1 next-situation of _Situation01) = _Situation02)

((the2 next-situation of _Situation01) = _Action01)

((the1 of                                         ; Take first element of ...
       (theoneof (the next-situation of _Situation01) ; the next-situation structure..
           where ((the2 of It) = _Action01)))       ; whose second element is _Action01
  = _Situation02)

;;; ---------- another one

(S has (instance-of (Situation)))
(S2 has (instance-of (Situation)))
(S has (next-situation ((:args S2 A))))

(in-situation (the next-situation of S))

((the prev-situation of S2) = (:args S A))

((the prev-situation of (curr-situation)) = (:args S A))

(in-situation (the prev-situation of (curr-situation)))

((curr-situation) = S)

;;; ----------
;;; A little KB...
;;; ----------

(reset-kb)

(position has 
  (instance-of (Slot))
  (fluent-status (*Inertial-Fluent)))

(Action has (superclasses (Event)))

(Switching-On has (superclasses (Action)))
(every Switching-On has
  (object ((a Switch)))
  (pcs-list ((:triple (the object of Self) position *Down)))
  (del-list ((:triple (the object of Self) position *Down)))
  (add-list ((:triple (the object of Self) position *Up))))

(Switching-Off has (superclasses (Action)))

(every Switching-Off has
  (object ((a Switch)))
  (pcs-list ((:triple (the object of Self) position *Up)))
  (del-list ((:triple (the object of Self) position *Up)))
  (add-list ((:triple (the object of Self) position *Down))))

(Switch has (superclasses (Physobj)))

(*Up   has (instance-of (Switch-Position)))
(*Down has (instance-of (Switch-Position)))

(every Light has
  (brightness ((if   ((the position of (the controlled-by of Self)) = *Up) 
                then *Bright
                else (if   ((the position of (the controlled-by of Self)) = *Down) 
                      then *Dark)))))

; new
(brightness has 
  (instance-of (Slot))
  (fluent-status (*Fluent)))

(*Switch1 has (instance-of (Switch)))

(*Light1 has 
  (instance-of (Light))
  (controlled-by (*Switch1)))

(new-situation)                             ; Create initial situation

(*Switch1 has (position (*Down)))  ; initial switch position

((the brightness of *Light1) = *Dark)

(S0 == (a Switching-On with (object (*Switch1))))

(do-and-next S0)    ; Do it!!

((the position of *Switch1) = *Up)

((the brightness of *Light1) = *Bright)                                       ; ...and its ramifications

(in-situation (the prev-situation of (curr-situation)) 
	((the brightness of *Light1) = *Dark))

;;; ----------------------------------------

(reset-kb)

(contents has 
  (instance-of (Slot))
  (fluent-status (*Inertial-Fluent)))

(Action has (superclasses (Event)))

(Getting has (superclasses (Action)))

(every Getting has
  (object ((a Thing)))
  (source ((a Box)))
  (pcs-list ((:triple (the source of Self) contents (the object of Self))))    ; [1]
  (del-list ((:triple (the source of Self) contents (the object of Self)))))

(Putting has (superclasses (Action)))

(every Putting has
  (object ((a Thing)))
  (destination ((a Box)))
  (ncs-list ((:triple (the destination of Self) contents (the object of Self))))  ; [1]
  (add-list ((:triple (the destination of Self) contents (the object of Self)))))

(*My-Box has (instance-of (Box))) 	            ; Create a box...

(*BlockA has (instance-of (Block)))                 ; and two blocks...

(*BlockB has (instance-of (Block)))

;;; ----------
;;; Extra test of ncs and pcs here:
;;; ----------

(new-situation)

(do-and-next (a Getting with          ; Take *BlockA out...
                                    (object (*BlockA))              
                                    (source (*My-Box))))

(not (the contents of *My-Box))

;;; Implied by pcs
(in-situation (the prev-situation of (curr-situation))
	((the contents of *My-Box) = *BlockA))

(do-and-next (a Getting with          ; Take *BlockB out...
                                    (object (*BlockB))              
                                    (source (*My-Box))))

;;; Now we have a changed information implied. 
;;; But KM won't project BlockB right back to the first situation
(in-situation (the prev-situation of (curr-situation))
	((the contents of *My-Box) = *BlockB))

;;; ----------

(new-situation)
;(*My-Box has (contents (*BlockA)))
;(next-situation)

(do-and-next (a Putting with          ; Put *BlockA in...
                                    (object (*BlockA))              
                                    (destination (*My-Box))))

;;; Actually, can't test like this, I get NIL &? *BlockA, which succeeds.
;;; Implied by ncs
;(in-situation (the prev-situation of (curr-situation))
;	(not ((the contents of *My-Box) &? *BlockA)))

;;; Instead, check constraint is there by checking projection is blocked...
;;; Here I check *BlockA "disappears"...slightly strange as a test, but
;;; it'll do...

(in-situation (the prev-situation of (curr-situation))
	(not (the contents of *My-Box)))

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

;;; back to the manual...

(new-situation)                                     ; Enter a situation...

(do-and-next (a Putting with          ; Put *BlockA in...
                                    (object (*BlockA))              
                                    (destination (*My-Box))))

((the contents of *My-Box) = *BlockA)                              ; *BlockA there!

(do-and-next (a Putting with          ; Put *BlockB in...
                                      (object (*BlockB))                       
                                      (destination (*My-Box))))

((the contents of *My-Box) = (:set *BlockA *BlockB))

(do-and-next (a Getting with          ; Take *BlockA out...
                                      (object (*BlockA))                        
                                      (source (*My-Box))))

((the contents of *My-Box) = *BlockB)                                 ; Just *BlockB left

(do-and-next (a Getting with          ; Take *BlockB out
                                     (object (*BlockB))
                                     (source (*My-Box))))

(not (the contents of *My-Box))

;;; ----------

(Switching-On has (superclasses (Action)))

;;; trivial demo of projection...

(color has
  (instance-of (Slot))
  (fluent-status (*Inertial-Fluent)))

(new-situation)

(*Switch1 has (position (*Down)))

(*Switch1 has (color (*Red)))

(do-and-next  (a Switching-On with (object (*Switch1))))

((the color of *Switch1) = *Red)

;;; ----------

(global-situation)

(possible-actions has
      (instance-of (Slot))
      (fluent-status (*Fluent)))

(every Action has
      (is-possible ((    (all-true (the pcs-list of Self))
                     and (not (some-true (the ncs-list of Self)))))))

(is-possible has
       (instance-of (Slot))
       (fluent-status (*Fluent))
       (situation-specific (t)))

(*My-Box has (instance-of (Container)))

(*BlockA has (instance-of (Block)))

(*BlockB has (instance-of (Block)))

(new-situation)

(not (the contents of *My-Box))

((the number of
  (allof (:set (a Getting with (object (*BlockA)) (source (*My-Box)))
               (a Getting with (object (*BlockB)) (source (*My-Box)))
               (a Putting with (object (*BlockA)) (destination (*My-Box)))
               (a Putting with (object (*BlockB)) (destination (*My-Box))))
   where (the is-possible of It))) = 2)
; (_Putting32 _Putting33)                         ; Can put *BlockA or *BlockB in *My-Box

; [_Situation29] KM> (do-and-next _Putting32)
(do-and-next                (a Putting with (object (*BlockA)) (destination (*My-Box))))

((the contents of *My-Box) = *BlockA)

((the number of (allof (:set
                           (a Getting with (object (*BlockA)) (source (*My-Box)))
                           (a Getting with (object (*BlockB)) (source (*My-Box)))
                           (a Putting with (object (*BlockA)) (destination (*My-Box)))
                           (a Putting with (object (*BlockB)) (destination (*My-Box))))
                    where (the is-possible of It))) = 2)

((the number of (allof (:set
                           (a Getting with (object (*BlockA)) (source (*My-Box)))
                           (a Getting with (object (*BlockB)) (source (*My-Box)))
                           (a Putting with (object (*BlockA)) (destination (*My-Box)))
                           (a Putting with (object (*BlockB)) (destination (*My-Box))))
                    where ((the is-possible of It) and (It isa Getting)))) = 1)

((the number of (allof (:set
                           (a Getting with (object (*BlockA)) (source (*My-Box)))
                           (a Getting with (object (*BlockB)) (source (*My-Box)))
                           (a Putting with (object (*BlockA)) (destination (*My-Box)))
                           (a Putting with (object (*BlockB)) (destination (*My-Box))))
                    where ((the is-possible of It) and (It isa Putting)))) = 1)

; (_Getting41 _Putting44)                         ; Either you can get *BlockA out, or 
;                                                ; put *BlockB back in.

;;; ======================================================================
;;;			DEMO KB
;;; ======================================================================

(reset-kb)

(subevents has (fluent-status (*Non-Fluent)))

(position has 
  (instance-of (Slot))
  (fluent-status (*Inertial-Fluent)))

(*My-Circuit has
  (instance-of (Circuit))
  (switches (*Switch1 *Switch2))
  (lights (*Light1 *Light2))
  (parts ((the lights of Self) (the switches of Self))))

(*Light1 has 
  (instance-of (Light))
  (controlled-by (*Switch1)))

(*Light2 has 
  (instance-of (Light))
  (controlled-by (*Switch2)))

(*Switch1 has (instance-of (Switch)))
(*Switch2 has (instance-of (Switch)))

(illuminated-lights has (instance-of (Slot)) (fluent-status (*Fluent)))
(brightness         has (instance-of (Slot)) (fluent-status (*Fluent)))
(possible-actions   has (instance-of (Slot)) (fluent-status (*Fluent)))
(applicable-actions has (instance-of (Slot)) (fluent-status (*Fluent)))
(is-possible        has (instance-of (Slot)) (fluent-status (*Fluent)))

(is-possible        has (situation-specific (t)))

(Circuit has (superclasses (Physobj)))

(every Circuit has
  (illuminated-lights (
        (allof (the lights of Self)
         where ((the brightness of It) = *Bright)))))

(every Light has
  (brightness ((if   ((the position of (the controlled-by of Self)) = *Up) 
                then *Bright 
                else (if   ((the position of (the controlled-by of Self)) = *Down)
                      then *Dark)))))

(Action has (superclasses (Event)))

(every Action has
  (is-possible ((    (all-true (the pcs-list of Self))
                 and (not (some-true (the ncs-list of Self)))))))

(Switching-On has (superclasses (Action)))

(every Switching-On has
  (object ((a Switch)))
  (pcs-list ((:triple (the object of Self) position *Down)))
  (del-list ((:triple (the object of Self) position *Down)))
  (add-list ((:triple (the object of Self) position *Up))))

(Switching-Off has (superclasses (Action)))

(every Switching-Off has
  (object ((a Switch)))
  (pcs-list ((:triple (the object of Self) position *Up)))
  (del-list ((:triple (the object of Self) position *Up)))
  (add-list ((:triple (the object of Self) position *Down))))


(Switch has (superclasses (Physobj)))

(every Switch has
  (applicable-actions (
    (a Switching-Off with (object (Self)))
    (a Switching-On  with (object (Self))))))

(every Physobj has
  (possible-actions (
     (allof (the applicable-actions of Self) 
      where (the is-possible of It))                           ; [1]
     (the possible-actions of (the parts of Self)))))          ; [2]

(My-Plan has (superclasses (Plan)))
(every My-Plan has
  (subevents (
    (a Switching-On with (object (*Switch1)))           ; step 1
    (a Switching-On with (object (*Switch2)))           ; step 2
    (a Switching-Off with (object (*Switch1)))          ; step 3
        )))

(*My-Plan has (instance-of (My-Plan)))
(*My-Plan2 has (instance-of (My-Plan)))

((the number of (the subevents of *My-Plan)) = 3)

; (_Switching-On2 _Switching-On3 _Switching-Off4)           ; The three steps

(new-situation)                                       ; Define initial situation

 (*Switch1 has (position (*Down)))
(*Switch2 has (position (*Down)))

(do-and-next (the first of (the subevents of *My-Plan)))

(do-and-next (the second of (the subevents of *My-Plan)))

(do-and-next (the third of (the subevents of *My-Plan)))

((the illuminated-lights of *My-Circuit) = *Light2)                        ; Just *Light2 on

(new-context)

(in-situation *Global (NS == (a Situation)))

(in-situation NS)

(*Switch1 has (position (*Down)))
(*Switch2 has (position (*Down)))

(forall (in-situation *Global (the subevents of *My-Plan2))
                      (do-and-next It))

((the illuminated-lights of *My-Circuit) = *Light2)

;;; Note - two answers, from the two simulations separate simulations run above
((the number of
  (allof (the all-instances of Situation)
     where (in-situation It (    ((the position of *Switch1) = *Up)
                             and ((the position of *Switch2) = *Up)))))
 = 2)

;;; ----------

(global-situation)

(future-situations has (fluent-status (*Non-Fluent)))

(every Situation has 
        (future-situations ((the next-situation of Self)
                            (the future-situations of (the next-situation of Self)))))

((the number of (the future-situations of NS)) = 3)

;;; should be one!
((the number of
    (allof (:set NS (the future-situations of NS))
     where (in-situation It (    ((the position of *Switch1) = *Up)
                             and ((the position of *Switch2) = *Up)))))
 = 1)

;;; --------------------
;;;	POSSIBLE WORLDS
;;; --------------------

(S7 == (a Situation))

(in-situation S7)                     ; Define initial situation

(*Switch1 has (position (*Down)))
(*Switch2 has (position (*Down)))

((the number of (the possible-actions of *My-Circuit)) = 2)
; (_Switching-On246 _Switching-On250)

;(trace)

;;; This should work, to give names to the resulting situations
(((forall (the possible-actions of *My-Circuit) (do It))) === (S8 S9))


(showme S7)             ; Note: Still in initial situation
; (_Situation7 has
;  (next-situation ((:args _Situation8 _Switching-On246)
;                   (:args _Situation9 _Switching-On250))))

((the1 next-situation of S7) = (:set S8 S9))

(in-situation S8 ((the brightness of *Light1) = *Bright))          ; (i.e., yes)

(in-situation S9 ((the brightness of *Light1) = *Dark))             ; (i.e., no)

((oneof (the1 next-situation of S7)
     where (in-situation It ((the brightness of *Light1) = *Bright))) = S8)

((the2 prev-situation of S8) isa Switching-On)

((the2 prev-situation of S8) == *My-Switching-On)

(in-situation S7 ((the object of *My-Switching-On) = *Switch1))

;;; ----------
;;; Creation and Destruction...
;;; ----------

(reset-kb)

(is-material has 
  (instance-of (Slot))
  (fluent-status (*Inertial-Fluent)))

(Action has (superclasses (Event)))

(Baking has (superclasses (Action)))
(every Baking has
      (agent ((a Person)))
      (ingredients ((must-be-a Food)))
      (result ((must-be-a Food)))           ; (sometimes violated in practice... :-))
      (pcs-list ((forall (the ingredients of Self)
                     (:triple It is-material t))))             			; [1]
      (ncs-list ((:triple (the result of Self) is-material t)))                 ; [2]
      (add-list ((:triple (the result of Self) is-material t)))                 ; [3]
      (del-list ((forall (the ingredients of Self)
                     (:triple It is-material t)))))                             ; [4]

(Baking-A-Cake has (superclasses (Baking)))

(every Baking-A-Cake has
      (ingredients ((a Piece-Of-Flour) (a Piece-Of-Sugar) (a Piece-Of-Butter) 
                    (a Egg) (a Egg)))
      (result ((a Cake))))

(agent has (instance-of (Slot)) (fluent-status (*Non-Fluent)))
(result has (instance-of (Slot)) (fluent-status (*Non-Fluent)))

(*Pete has (instance-of (Person)))

(a Baking-A-Cake with
                  (agent (*Pete)))

(new-situation)

(do-and-next (the Baking-A-Cake))

(the is-material of (the result of (thelast Baking-A-Cake)))

(not (the is-material of
                        (the Piece-Of-Four ingredients of (thelast Baking-A-Cake))))

(in-situation (the prev-situation of (curr-situation))
                                (the is-material of
                                  (the Piece-Of-Flour ingredients of 
                                    (thelast Baking-A-Cake))))
; (t)

;;; ======================================================================
;;;	THE MAGICIAN'S RABBIT
;;; ======================================================================

(reset-kb)

(instance-of-is-fluent)

(Action has (superclasses (Event)))

(Create has (superclasses (Action)))
(Change has (superclasses (Action)))
(Destroy has (superclasses (Action)))

(new-situation)

(do-and-next
   (a Create with 
     (created (*MyThing))
     (will-be-a (Rabbit))
     (add-list ((:triple (the created of Self) instance-of (the will-be-a of Self))))))

(do-and-next
   (a Change with 
     (changed (*MyThing))
     (will-be-a (Dove))
     (del-list ((:triple (the changed of Self) instance-of 
                                          (the instance-of of (the changed of Self)))))
     (add-list ((:triple (the changed of Self) instance-of (the will-be-a of Self))))))

(do-and-next
  (a Destroy with 
     (destroyed (*MyThing))
     (del-list ((:triple (the destroyed of Self) instance-of 
                                       (the instance-of of (the destroyed of Self)))))))

((forall (the instances of Situation)
	 (in-situation It (the instance-of of *MyThing))) = 
 (:set Thing Rabbit Dove))

;;; ======================================================================
;;;	try-do, and try-do-and-next, and checking for consistency of PCs:
;;; ======================================================================

(reset-kb)

(position has 
  (instance-of (Slot))
  (cardinality (N-to-1))
  (fluent-status (*Inertial-Fluent)))

(Action has (superclasses (Event)))

(Switching-On has (superclasses (Action)))
(every Switching-On has
  (object ((a Switch)))
  (pcs-list ((:triple (the object of Self) position *Down)))
  (del-list ((:triple (the object of Self) position *Down)))
  (add-list ((:triple (the object of Self) position *Up))))

(Switching-Off has (superclasses (Action)))

(every Switching-Off has
  (object ((a Switch)))
  (pcs-list ((:triple (the object of Self) position *Up)))
  (del-list ((:triple (the object of Self) position *Up)))
  (add-list ((:triple (the object of Self) position *Down))))

(Switch has (superclasses (Physobj)))

(*Up   has (instance-of (Switch-Position)))
(*Down has (instance-of (Switch-Position)))

(every Light has
  (brightness ((if   ((the position of (the controlled-by of Self)) = *Up) 
                then *Bright
                else (if   ((the position of (the controlled-by of Self)) = *Down) 
                      then *Dark)))))

; new
(brightness has 
  (instance-of (Slot))
  (fluent-status (*Fluent)))

(*Switch1 has (instance-of (Switch)))

(*Light1 has 
  (instance-of (Light))
  (controlled-by (*Switch1)))

(object has (fluent-status (*Inertial-Fluent)))		; New: 2/8/00

(new-situation)                             ; Create initial situation

(S0 == (a Switching-On with (object (*Switch1))))

;;; Preconditions not satisfied...
(not (try-do S0))
(not (try-do-and-next S0))

;;; so assume them...
(do-and-next S0)

;;; Can't do this action again, as the preconditions would be inconsistent...
(not (do-and-next S0))

;;; null action...
(next-situation)

;;; Still can't do them...
(not (do-and-next S0))

;;; But can do this...
(do-and-next (a Switching-Off with (object (*Switch1))))

;;; But not a second time
(not (do-and-next (a Switching-Off with (object (*Switch1)))))

;;; ----------------------------------------
;;; Alternative formulation, using ncs-list:

(reset-kb)

(position has 
  (instance-of (Slot))
  (cardinality (N-to-1))
  (fluent-status (*Inertial-Fluent)))

(Action has (superclasses (Event)))

(Switching-On has (superclasses (Action)))
(every Switching-On has
  (object ((a Switch)))
  (ncs-list ((:triple (the object of Self) position *Up)))	; NB ncs-list
  (del-list ((:triple (the object of Self) position *Down)))
  (add-list ((:triple (the object of Self) position *Up))))

(Switching-Off has (superclasses (Action)))

(every Switching-Off has
  (object ((a Switch)))
  (ncs-list ((:triple (the object of Self) position *Down)))	; NB ncs-list
  (del-list ((:triple (the object of Self) position *Up)))
  (add-list ((:triple (the object of Self) position *Down))))

(Switch has (superclasses (Physobj)))

(*Up   has (instance-of (Switch-Position)))
(*Down has (instance-of (Switch-Position)))

(every Light has
  (brightness ((if   ((the position of (the controlled-by of Self)) = *Up) 
                then *Bright
                else (if   ((the position of (the controlled-by of Self)) = *Down) 
                      then *Dark)))))

; new
(brightness has 
  (instance-of (Slot))
  (fluent-status (*Fluent)))

(*Switch1 has (instance-of (Switch)))

(*Light1 has 
  (instance-of (Light))
  (controlled-by (*Switch1)))

(object has (fluent-status (*Inertial-Fluent)))		; New: 2/8/00

(new-situation)                             ; Create initial situation

(S0 == (a Switching-On with (object (*Switch1))))

(do-and-next S0)

;;; Can't do this action again, as the preconditions would be inconsistent...
(not (do-and-next S0))

;;; null action...
(next-situation)

;;; Still can't do them...
(not (do-and-next S0))

;;; But can do this...
(do-and-next (a Switching-Off with (object (*Switch1))))

;;; But not a second time
(not (do-and-next (a Switching-Off with (object (*Switch1)))))

;;; ======================================================================
;;;	TEST SITUATION-SPECIFIC:
;;; ======================================================================
#|
Redundant now
(reset-kb)

(location has
  (situation-specific (t)))

(every Car has (location ((a Place))))

;;; This should fail in the global situation!
(not (the location of (a Car)))
|#

;;; ======================================================================
;;;		AGAIN...
;;; ======================================================================

;;; Test suite for new situations manual...

(reset-kb)

(*Joe has                                           ; Global KB assertion
        (instance-of (Person))                          ; (visible to all Situations)
        (birthdate (1963)))

(S == (a Situation))

(in-situation S)

((the birthdate of *Joe) = 1963)               ; Global facts are visible

(*Joe has (mood (*Happy)))            ; Make a local assertion

((the mood of *Joe) = *Happy)

; (in-situation *Global)

; (not (the mood of *Joe))                                  ; Local assertions are not

(S2 == (a Situation))

(in-situation S2)

(*Joe has (mood (*Sad)))              ; Alternative assertion

((the mood of *Joe) = *Sad)

(in-situation *Global)

(new-situation)
(curr-situation)
(global-situation)

(in-situation S ((the mood of *Joe) = *Happy))
(in-situation S2 ((the mood of *Joe) = *Sad))

((oneof (the all-instances of Situation)
     where (in-situation It ((the mood of *Joe) = *Happy))) = S)

;;; ----------

(every Person has
      (year-of-birth ((a Number)))                                 ; (in years)
      (age (((the year of *Todays-Date) - (the year-of-birth of Self)))))

(*Fred has
      (instance-of (Person))
      (year-of-birth (1963)))

(new-situation)

(*Todays-Date has
                      (year (2000)))

((the year-of-birth of *Fred) = 1963)
((the age of *Fred) = 37)

(year-of-birth has
       (instance-of (Slot))
       (fluent-status (*Non-Fluent)))

;;; --------------------

(a Situation with
       (date (4-20-00))
       (time (*Morning)))

(*Petes-Thursday-Morning has
        (instance-of (Situation))
        (date (4-20-00))
        (time (*Morning)))

(in-situation *Petes-Thursday-Morning)

 (*Pete has
                                (location ((a Chair with 
                                              (in-front-of ((a Computer)))))))

(global-situation)

(*Petes-Thursday-Morning has
       (main-participant (*Pete)))

(S4 == (a Situation with
      (main-participant ((a Person)))))

(in-situation S4
        ((the main-participant of S4) has (location ((a Chair)))))

(S4b == (a Situation with
          (main-participant ((a Person)))
          (assertions ('((the main-participant of #,Self) has (location ((a Chair))))))))

(in-situation S4 ((the location of (the main-participant of S4)) isa Chair))
(in-situation S4b ((the location of (the main-participant of S4b)) isa Chair))

;;; ----------

(Falling-Situation has (superclasses (Situation)))

(every Falling-Situation has
      (agent ((a Person))))

(in-every-situation Falling-Situation
        ((the agent of TheSituation) has (feelings (*Scared))))

;;; This is the internal representation, which the above generates. Note the #, unquoting is needed now.
(every Falling-Situation2 has
       (assertions ('((the agent of #,Self) has (feelings (*Scared))))))

(*Pete has (instance-of (Person)))

(FS == (a Falling-Situation with (agent (*Pete))))
(in-situation FS ((the feelings of *Pete) = *Scared))

(FS2 == (a Falling-Situation with (agent (*Pete))))
(in-situation FS2 ((the feelings of *Pete) = *Scared))

;;; ----------

(:triple *Pete state *Happy)

(every Person has
      (belief ((:triple Self state *Happy))))

(reset-kb)

(every Person has
      (belief ((forall (the has-pets of Self)
                       (:triple It state *Happy)))))

((the belief of (a Person with (has-pets (*Fido)))) = (:triple *Fido state *Happy))

;;; ----------

(every Person has
      (belief ((:triple (the house-lived-in of Self) appearance *Beautiful))))

;To do ...
;(not (is-true (:triple *Pete state *Happy)))

;(assert (:triple *Pete state *Happy))
;
;(is-true (:triple *Pete state *Happy))
;
;((the state of *Pete) = *Happy)

;;; ----------

(Switching-On has (superclasses (Action)))

(every Switching-On has
  (object ((a Switch)))
  (pcs-list ((:triple (the object of Self) position *Down)))
  (del-list ((:triple (the object of Self) position *Down)))
  (add-list ((:triple (the object of Self) position *Up))))

;;; ----------
;;; This should become built-in:

(_Situation01 has (instance-of (Situation)))
(_Situation02 has (instance-of (Situation)))

(_Situation01 has
      (next-situation ((:args _Situation02 _Action01))))

((the next-situation of _Situation01) = (:args _Situation02 _Action01))

((the before-situation of _Action01) = (:args _Situation01 _Situation02))

((the1 next-situation of _Situation01) = _Situation02)

((the2 next-situation of _Situation01) = _Action01)

((the1 of                                         ; Take first element of ...
       (theoneof (the next-situation of _Situation01) ; the next-situation structure..
           where ((the2 of It) = _Action01)))       ; whose second element is _Action01
  = _Situation02)

;;; ---------- another one

(S has (instance-of (Situation)))
(S2 has (instance-of (Situation)))
(S has (next-situation ((:args S2 A))))

(in-situation (the next-situation of S))

((the prev-situation of S2) = (:args S A))

((the prev-situation of (curr-situation)) = (:args S A))

(in-situation (the prev-situation of (curr-situation)))

((curr-situation) = S)

;;; ----------
;;; A little KB...
;;; ----------

(reset-kb)

(position has 
  (instance-of (Slot))
  (fluent-status (*Inertial-Fluent)))

(Action has (superclasses (Event)))

(Switching-On has (superclasses (Action)))
(every Switching-On has
  (object ((a Switch)))
  (pcs-list ((:triple (the object of Self) position *Down)))
  (del-list ((:triple (the object of Self) position *Down)))
  (add-list ((:triple (the object of Self) position *Up))))

(Switching-Off has (superclasses (Action)))

(every Switching-Off has
  (object ((a Switch)))
  (pcs-list ((:triple (the object of Self) position *Up)))
  (del-list ((:triple (the object of Self) position *Up)))
  (add-list ((:triple (the object of Self) position *Down))))

(Switch has (superclasses (Physobj)))

(*Up   has (instance-of (Switch-Position)))
(*Down has (instance-of (Switch-Position)))

(every Light has
  (brightness ((if   ((the position of (the controlled-by of Self)) = *Up) 
                then *Bright
                else (if   ((the position of (the controlled-by of Self)) = *Down) 
                      then *Dark)))))

; new
(brightness has 
  (instance-of (Slot))
  (fluent-status (*Fluent)))

(*Switch1 has (instance-of (Switch)))

(*Light1 has 
  (instance-of (Light))
  (controlled-by (*Switch1)))

(new-situation)                             ; Create initial situation

(*Switch1 has (position (*Down)))  ; initial switch position

((the brightness of *Light1) = *Dark)

(S0 == (a Switching-On with (object (*Switch1))))

(do-and-next S0)    ; Do it!!

((the position of *Switch1) = *Up)

((the brightness of *Light1) = *Bright)                                       ; ...and its ramifications

(in-situation (the prev-situation of (curr-situation)) 
	((the brightness of *Light1) = *Dark))

;;; ----------------------------------------

(reset-kb)

(contents has 
  (instance-of (Slot))
  (fluent-status (*Inertial-Fluent)))

(Action has (superclasses (Event)))

(Getting has (superclasses (Action)))

(every Getting has
  (object ((a Thing)))
  (source ((a Box)))
  (pcs-list ((:triple (the source of Self) contents (the object of Self))))    ; [1]
  (del-list ((:triple (the source of Self) contents (the object of Self)))))

(Putting has (superclasses (Action)))

(every Putting has
  (object ((a Thing)))
  (destination ((a Box)))
  (ncs-list ((:triple (the destination of Self) contents (the object of Self))))  ; [1]
  (add-list ((:triple (the destination of Self) contents (the object of Self)))))

(*My-Box has (instance-of (Box))) 	            ; Create a box...

(*BlockA has (instance-of (Block)))                 ; and two blocks...

(*BlockB has (instance-of (Block)))

;;; ----------
;;; Extra test of ncs and pcs here:
;;; ----------

(new-situation)

(do-and-next (a Getting with          ; Take *BlockA out...
                                    (object (*BlockA))              
                                    (source (*My-Box))))

(not (the contents of *My-Box))

;;; Implied by pcs
(in-situation (the prev-situation of (curr-situation))
	((the contents of *My-Box) = *BlockA))

(do-and-next (a Getting with          ; Take *BlockB out...
                                    (object (*BlockB))              
                                    (source (*My-Box))))

;;; Now we have a changed information implied. 
;;; But KM won't project BlockB right back to the first situation
(in-situation (the prev-situation of (curr-situation))
	((the contents of *My-Box) = *BlockB))

;;; ----------

(new-situation)
;(*My-Box has (contents (*BlockA)))
;(next-situation)

(do-and-next (a Putting with          ; Put *BlockA in...
                                    (object (*BlockA))              
                                    (destination (*My-Box))))

;;; Actually, can't test like this, I get NIL &? *BlockA, which succeeds.
;;; Implied by ncs
;(in-situation (the prev-situation of (curr-situation))
;	(not ((the contents of *My-Box) &? *BlockA)))

;;; Instead, check constraint is there by checking projection is blocked...
;;; Here I check *BlockA "disappears"...slightly strange as a test, but
;;; it'll do...

(in-situation (the prev-situation of (curr-situation))
	(not (the contents of *My-Box)))

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

;;; back to the manual...

(new-situation)                                     ; Enter a situation...

(do-and-next (a Putting with          ; Put *BlockA in...
                                    (object (*BlockA))              
                                    (destination (*My-Box))))

((the contents of *My-Box) = *BlockA)                              ; *BlockA there!

(do-and-next (a Putting with          ; Put *BlockB in...
                                      (object (*BlockB))                       
                                      (destination (*My-Box))))

((the contents of *My-Box) = (:set *BlockA *BlockB))

(do-and-next (a Getting with          ; Take *BlockA out...
                                      (object (*BlockA))                        
                                      (source (*My-Box))))

((the contents of *My-Box) = *BlockB)                                 ; Just *BlockB left

(do-and-next (a Getting with          ; Take *BlockB out
                                     (object (*BlockB))
                                     (source (*My-Box))))

(not (the contents of *My-Box))

;;; ----------

(Switching-On has (superclasses (Action)))

;;; trivial demo of projection...

(color has
  (instance-of (Slot))
  (fluent-status (*Inertial-Fluent)))

(new-situation)

(*Switch1 has (position (*Down)))

(*Switch1 has (color (*Red)))

(do-and-next  (a Switching-On with (object (*Switch1))))

((the color of *Switch1) = *Red)

;;; ----------

(global-situation)

(possible-actions has
      (instance-of (Slot))
      (fluent-status (*Fluent)))

(every Action has
      (is-possible ((    (all-true (the pcs-list of Self))
                     and (not (some-true (the ncs-list of Self)))))))

(is-possible has
       (instance-of (Slot))
       (fluent-status (*Fluent))
       (situation-specific (t)))

(*My-Box has (instance-of (Container)))

(*BlockA has (instance-of (Block)))

(*BlockB has (instance-of (Block)))

(new-situation)

(not (the contents of *My-Box))

((the number of
  (allof (:set (a Getting with (object (*BlockA)) (source (*My-Box)))
               (a Getting with (object (*BlockB)) (source (*My-Box)))
               (a Putting with (object (*BlockA)) (destination (*My-Box)))
               (a Putting with (object (*BlockB)) (destination (*My-Box))))
   where (the is-possible of It))) = 2)
; (_Putting32 _Putting33)                         ; Can put *BlockA or *BlockB in *My-Box

; [_Situation29] KM> (do-and-next _Putting32)
(do-and-next                (a Putting with (object (*BlockA)) (destination (*My-Box))))

((the contents of *My-Box) = *BlockA)

((the number of (allof (:set
                           (a Getting with (object (*BlockA)) (source (*My-Box)))
                           (a Getting with (object (*BlockB)) (source (*My-Box)))
                           (a Putting with (object (*BlockA)) (destination (*My-Box)))
                           (a Putting with (object (*BlockB)) (destination (*My-Box))))
                    where (the is-possible of It))) = 2)

((the number of (allof (:set
                           (a Getting with (object (*BlockA)) (source (*My-Box)))
                           (a Getting with (object (*BlockB)) (source (*My-Box)))
                           (a Putting with (object (*BlockA)) (destination (*My-Box)))
                           (a Putting with (object (*BlockB)) (destination (*My-Box))))
                    where ((the is-possible of It) and (It isa Getting)))) = 1)

((the number of (allof (:set
                           (a Getting with (object (*BlockA)) (source (*My-Box)))
                           (a Getting with (object (*BlockB)) (source (*My-Box)))
                           (a Putting with (object (*BlockA)) (destination (*My-Box)))
                           (a Putting with (object (*BlockB)) (destination (*My-Box))))
                    where ((the is-possible of It) and (It isa Putting)))) = 1)

; (_Getting41 _Putting44)                         ; Either you can get *BlockA out, or 
;                                                ; put *BlockB back in.

;;; ======================================================================
;;;			DEMO KB
;;; ======================================================================

(reset-kb)

(subevents has (fluent-status (*Non-Fluent)))

(position has 
  (instance-of (Slot))
  (fluent-status (*Inertial-Fluent)))

(*My-Circuit has
  (instance-of (Circuit))
  (switches (*Switch1 *Switch2))
  (lights (*Light1 *Light2))
  (parts ((the lights of Self) (the switches of Self))))

(*Light1 has 
  (instance-of (Light))
  (controlled-by (*Switch1)))

(*Light2 has 
  (instance-of (Light))
  (controlled-by (*Switch2)))

(*Switch1 has (instance-of (Switch)))
(*Switch2 has (instance-of (Switch)))

(illuminated-lights has (instance-of (Slot)) (fluent-status (*Fluent)))
(brightness         has (instance-of (Slot)) (fluent-status (*Fluent)))
(possible-actions   has (instance-of (Slot)) (fluent-status (*Fluent)))
(applicable-actions has (instance-of (Slot)) (fluent-status (*Fluent)))
(is-possible        has (instance-of (Slot)) (fluent-status (*Fluent)))

(is-possible        has (situation-specific (t)))

(Circuit has (superclasses (Physobj)))

(every Circuit has
  (illuminated-lights (
        (allof (the lights of Self)
         where ((the brightness of It) = *Bright)))))

(every Light has
  (brightness ((if   ((the position of (the controlled-by of Self)) = *Up) 
                then *Bright 
                else (if   ((the position of (the controlled-by of Self)) = *Down)
                      then *Dark)))))

(Action has (superclasses (Event)))

(every Action has
  (is-possible ((    (all-true (the pcs-list of Self))
                 and (not (some-true (the ncs-list of Self)))))))

(Switching-On has (superclasses (Action)))

(every Switching-On has
  (object ((a Switch)))
  (pcs-list ((:triple (the object of Self) position *Down)))
  (del-list ((:triple (the object of Self) position *Down)))
  (add-list ((:triple (the object of Self) position *Up))))

(Switching-Off has (superclasses (Action)))

(every Switching-Off has
  (object ((a Switch)))
  (pcs-list ((:triple (the object of Self) position *Up)))
  (del-list ((:triple (the object of Self) position *Up)))
  (add-list ((:triple (the object of Self) position *Down))))


(Switch has (superclasses (Physobj)))

(every Switch has
  (applicable-actions (
    (a Switching-Off with (object (Self)))
    (a Switching-On  with (object (Self))))))

(every Physobj has
  (possible-actions (
     (allof (the applicable-actions of Self) 
      where (the is-possible of It))                           ; [1]
     (the possible-actions of (the parts of Self)))))          ; [2]

(My-Plan has (superclasses (Plan)))
(every My-Plan has
  (subevents (
    (a Switching-On with (object (*Switch1)))           ; step 1
    (a Switching-On with (object (*Switch2)))           ; step 2
    (a Switching-Off with (object (*Switch1)))          ; step 3
        )))

(*My-Plan has (instance-of (My-Plan)))
(*My-Plan2 has (instance-of (My-Plan)))

((the number of (the subevents of *My-Plan)) = 3)

; (_Switching-On2 _Switching-On3 _Switching-Off4)           ; The three steps

(new-situation)                                       ; Define initial situation

 (*Switch1 has (position (*Down)))
(*Switch2 has (position (*Down)))

(do-and-next (the first of (the subevents of *My-Plan)))

(do-and-next (the second of (the subevents of *My-Plan)))

(do-and-next (the third of (the subevents of *My-Plan)))

((the illuminated-lights of *My-Circuit) = *Light2)                        ; Just *Light2 on

(new-context)

(in-situation *Global (NS == (a Situation)))

(in-situation NS)

(*Switch1 has (position (*Down)))
(*Switch2 has (position (*Down)))

(forall (in-situation *Global (the subevents of *My-Plan2))
                      (do-and-next It))

((the illuminated-lights of *My-Circuit) = *Light2)

;;; Note - two answers, from the two simulations separate simulations run above
((the number of
  (allof (the all-instances of Situation)
     where (in-situation It (    ((the position of *Switch1) = *Up)
                             and ((the position of *Switch2) = *Up)))))
 = 2)

;;; ----------

(global-situation)

(future-situations has (fluent-status (*Non-Fluent)))

(every Situation has 
        (future-situations ((the next-situation of Self)
                            (the future-situations of (the next-situation of Self)))))

((the number of (the future-situations of NS)) = 3)

;;; should be one!
((the number of
    (allof (:set NS (the future-situations of NS))
     where (in-situation It (    ((the position of *Switch1) = *Up)
                             and ((the position of *Switch2) = *Up)))))
 = 1)

;;; --------------------
;;;	POSSIBLE WORLDS
;;; --------------------

(S7 == (a Situation))

(in-situation S7)                     ; Define initial situation

(*Switch1 has (position (*Down)))
(*Switch2 has (position (*Down)))

((the number of (the possible-actions of *My-Circuit)) = 2)
; (_Switching-On246 _Switching-On250)

;;; This should work, to give names to the resulting situations
(((forall (the possible-actions of *My-Circuit) (do It))) === (S8 S9))


(showme S7)             ; Note: Still in initial situation
; (_Situation7 has
;  (next-situation ((:args _Situation8 _Switching-On246)
;                   (:args _Situation9 _Switching-On250))))

((the1 next-situation of S7) = (:set S8 S9))

(in-situation S8 ((the brightness of *Light1) = *Bright))          ; (i.e., yes)

(in-situation S9 ((the brightness of *Light1) = *Dark))             ; (i.e., no)

((oneof (the1 next-situation of S7)
     where (in-situation It ((the brightness of *Light1) = *Bright))) = S8)

((the2 prev-situation of S8) isa Switching-On)

((the2 prev-situation of S8) == *My-Switching-On)

(in-situation S7 ((the object of *My-Switching-On) = *Switch1))

;;; ----------
;;; Creation and Destruction...
;;; ----------

(reset-kb)

(is-material has 
  (instance-of (Slot))
  (fluent-status (*Inertial-Fluent)))

(Action has (superclasses (Event)))

(Baking has (superclasses (Action)))
(every Baking has
      (agent ((a Person)))
      (ingredients ((must-be-a Food)))
      (result ((must-be-a Food)))           ; (sometimes violated in practice... :-))
      (pcs-list ((forall (the ingredients of Self)
                     (:triple It is-material t))))             			; [1]
      (ncs-list ((:triple (the result of Self) is-material t)))                 ; [2]
      (add-list ((:triple (the result of Self) is-material t)))                 ; [3]
      (del-list ((forall (the ingredients of Self)
                     (:triple It is-material t)))))                             ; [4]

(Baking-A-Cake has (superclasses (Baking)))

(every Baking-A-Cake has
      (ingredients ((a Piece-Of-Flour) (a Piece-Of-Sugar) (a Piece-Of-Butter) 
                    (a Egg) (a Egg)))
      (result ((a Cake))))

(agent has (instance-of (Slot)) (fluent-status (*Non-Fluent)))
(result has (instance-of (Slot)) (fluent-status (*Non-Fluent)))

(*Pete has (instance-of (Person)))

(a Baking-A-Cake with
                  (agent (*Pete)))

(new-situation)

(do-and-next (the Baking-A-Cake))

(the is-material of (the result of (thelast Baking-A-Cake)))

(not (the is-material of
                        (the Piece-Of-Four ingredients of (thelast Baking-A-Cake))))

(in-situation (the prev-situation of (curr-situation))
                                (the is-material of
                                  (the Piece-Of-Flour ingredients of 
                                    (thelast Baking-A-Cake))))
; (t)

;;; ======================================================================
;;;	THE MAGICIAN'S RABBIT
;;; ======================================================================

(reset-kb)

(instance-of-is-fluent)

(Action has (superclasses (Event)))

(Create has (superclasses (Action)))
(Change has (superclasses (Action)))
(Destroy has (superclasses (Action)))

(new-situation)

(do-and-next
   (a Create with 
     (created (*MyThing))
     (will-be-a (Rabbit))
     (add-list ((:triple (the created of Self) instance-of (the will-be-a of Self))))))

(do-and-next
   (a Change with 
     (changed (*MyThing))
     (will-be-a (Dove))
     (del-list ((:triple (the changed of Self) instance-of 
                                          (the instance-of of (the changed of Self)))))
     (add-list ((:triple (the changed of Self) instance-of (the will-be-a of Self))))))

(do-and-next
  (a Destroy with 
     (destroyed (*MyThing))
     (del-list ((:triple (the destroyed of Self) instance-of 
                                       (the instance-of of (the destroyed of Self)))))))

((forall (the instances of Situation)
	 (in-situation It (the instance-of of *MyThing))) = 
 (:set Thing Rabbit Dove))

;;; ======================================================================
;;;	try-do, and try-do-and-next, and checking for consistency of PCs:
;;; ======================================================================

(reset-kb)

(position has 
  (instance-of (Slot))
  (cardinality (N-to-1))
  (fluent-status (*Inertial-Fluent)))

(Action has (superclasses (Event)))

(Switching-On has (superclasses (Action)))
(every Switching-On has
  (object ((a Switch)))
  (pcs-list ((:triple (the object of Self) position *Down)))
  (del-list ((:triple (the object of Self) position *Down)))
  (add-list ((:triple (the object of Self) position *Up))))

(Switching-Off has (superclasses (Action)))

(every Switching-Off has
  (object ((a Switch)))
  (pcs-list ((:triple (the object of Self) position *Up)))
  (del-list ((:triple (the object of Self) position *Up)))
  (add-list ((:triple (the object of Self) position *Down))))

(Switch has (superclasses (Physobj)))

(*Up   has (instance-of (Switch-Position)))
(*Down has (instance-of (Switch-Position)))

(every Light has
  (brightness ((if   ((the position of (the controlled-by of Self)) = *Up) 
                then *Bright
                else (if   ((the position of (the controlled-by of Self)) = *Down) 
                      then *Dark)))))

; new
(brightness has 
  (instance-of (Slot))
  (fluent-status (*Fluent)))

(*Switch1 has (instance-of (Switch)))

(*Light1 has 
  (instance-of (Light))
  (controlled-by (*Switch1)))

(object has (fluent-status (*Inertial-Fluent)))		; New: 2/8/00

(new-situation)                             ; Create initial situation

(S0 == (a Switching-On with (object (*Switch1))))

;;; Preconditions not satisfied...
(not (try-do S0))
(not (try-do-and-next S0))

;;; so assume them...
(do-and-next S0)

;;; Can't do this action again, as the preconditions would be inconsistent...
(not (do-and-next S0))

;;; null action...
(next-situation)

;;; Still can't do them...
(not (do-and-next S0))

;;; But can do this...
(do-and-next (a Switching-Off with (object (*Switch1))))

;;; But not a second time
(not (do-and-next (a Switching-Off with (object (*Switch1)))))

;;; ----------------------------------------
;;; Alternative formulation, using ncs-list:

(reset-kb)

(position has 
  (instance-of (Slot))
  (cardinality (N-to-1))
  (fluent-status (*Inertial-Fluent)))

(Action has (superclasses (Event)))

(Switching-On has (superclasses (Action)))
(every Switching-On has
  (object ((a Switch)))
  (ncs-list ((:triple (the object of Self) position *Up)))	; NB ncs-list
  (del-list ((:triple (the object of Self) position *Down)))
  (add-list ((:triple (the object of Self) position *Up))))

(Switching-Off has (superclasses (Action)))

(every Switching-Off has
  (object ((a Switch)))
  (ncs-list ((:triple (the object of Self) position *Down)))	; NB ncs-list
  (del-list ((:triple (the object of Self) position *Up)))
  (add-list ((:triple (the object of Self) position *Down))))

(Switch has (superclasses (Physobj)))

(*Up   has (instance-of (Switch-Position)))
(*Down has (instance-of (Switch-Position)))

(every Light has
  (brightness ((if   ((the position of (the controlled-by of Self)) = *Up) 
                then *Bright
                else (if   ((the position of (the controlled-by of Self)) = *Down) 
                      then *Dark)))))

; new
(brightness has 
  (instance-of (Slot))
  (fluent-status (*Fluent)))

(*Switch1 has (instance-of (Switch)))

(*Light1 has 
  (instance-of (Light))
  (controlled-by (*Switch1)))

(object has (fluent-status (*Inertial-Fluent)))		; New: 2/8/00

(new-situation)                             ; Create initial situation

(S0 == (a Switching-On with (object (*Switch1))))

(do-and-next S0)

;;; Can't do this action again, as the preconditions would be inconsistent...
(not (do-and-next S0))

;;; null action...
(next-situation)

;;; Still can't do them...
(not (do-and-next S0))

;;; But can do this...
(do-and-next (a Switching-Off with (object (*Switch1))))

;;; But not a second time
(not (do-and-next (a Switching-Off with (object (*Switch1)))))

;;; ======================================================================
;;;	TEST SITUATION-SPECIFIC:
;;; ======================================================================
#|
REDUNDANT NOW
(reset-kb)

(location has
  (situation-specific (t)))

(every Car has (location ((a Place))))

;;; This should fail in the global situation!
(not (the location of (a Car)))
|#


;;; ======================================================================
;;; as we're in situations, we DON'T want to try evaluating
;;; the age slot in *Global, normally a side-effect of performing "=="
;;; ======================================================================

(reset-kb)

(age has
  (cardinality (N-to-1)))

(pet has
  (cardinality (N-to-1))
  (fluent-status (*Non-Fluent)))

(_Man1 has 
	(instance-of (Man))
	(pet ((a Dog)))
	(age ((the age of _Man3) (must-be-a Number))))

(_Man2 has 
	(instance-of (Man))
	(pet (*Fido))
	(age ((the age of _Man4))))

(new-situation)

; (trace)

(_Man1 == _Man2)

(reset-kb)

(age has
  (cardinality (N-to-1)))

(pet has
  (cardinality (N-to-1))
  (fluent-status (*Non-Fluent)))

(_Man1 has 
	(instance-of (Man))
	(pet ((mustnt-be-a Dog)))
	(age ((the age of _Man3) (must-be-a Number))))

(_Man2 has 
	(instance-of (Man))
	(pet ((a Dog)))
	(age ((the age of _Man4))))

(new-situation)

; (trace)

;;; Check <> constraint IS tested for NON fluents
(not (_Man1 &? _Man2))

;;; ----------

;;; Let's try it again, and this time make sure that unification doesn't
;;; trigger classification in the global situation. In fact, we're safe,
;;; as unification of two objects in ALL situations only results in classification
;;; being retried in the CURRENT situation, which necessarily won't be global.

(reset-kb)

(_Man1 has 
	(instance-of (Man))
	(age ((the age of _Man3) (must-be-a Number))))

(_Man2 has 
	(instance-of (Man))
	(age ((the age of _Man4))))

(every OldMan has-definition
  (instance-of (Man))
  (age (*VeryOld)))

(every Twin has-definition
  (instance-of (Person))
  (age ((the age of (the brother of Self)))))

(new-situation)

(_Man1 == _Man2)

(global-situation)

(a Man)

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

(reset-kb)(untrace)(comment)

(NaCl has (superclasses (Chemical)))
(*NaCl has (instance-of (NaCl)))

(Biology-Situation has
	(superclasses (Situation )))
(in-every-situation Biology-Situation
	(every NaCl has
		(text ("Salt"))))

(in-situation (a Biology-Situation))
((the text of *NaCl) = "Salt")

(*Biology-Situation == (a Biology-Situation))
(in-situation *Biology-Situation)
((the text of *NaCl) = "Salt")

(*Biology-Situation2 has
	(instance-of (Biology-Situation)))
(in-situation *Biology-Situation2)
((the text of *NaCl) = "Salt")  ; was failing in 2.0.19 and earlier

;;; ---------- CONCURRENT ACTIONS ----------

(reset-kb)

(destination has (fluent-status (*Non-Fluent)))
(location has (fluent-status (*Inertial-Fluent)))

(every Move has
  (object ((a Thing)))
  (destination ((a Thing)))
  (del-list ((:triple (the object of Self) location (the location of (the object of Self)))))
  (add-list ((:triple (the object of Self) location (the destination of Self)))))

(new-situation)

(*Cup1 has
  (instance-of (Cup))
  (location (*Table1)))

(*Cup2 has
  (instance-of (Cup))
  (location (*Table1)))

(*Cup3 has
  (instance-of (Cup))
  (location (*Table1)))

;(forall (:set *Cup1 *Cup2 *Cup3)
;  (km-format t "~a has location ~a~%" It (the location of It)))

((the location of *Cup1) = *Table1)
((the location of *Cup2) = *Table1)
((the location of *Cup3) = *Table1)

(do-concurrently-and-next
  (:set (a Move with
          (object (*Cup1))
          (destination (*Table2)))
        (a Move with
          (object (*Cup3))
          (destination (*Table2)))))

;(forall (:set *Cup1 *Cup2 *Cup3)
;  (km-format t "~a now has location ~a~%" It (the location of It)))

((the location of *Cup1) = *Table2)
((the location of *Cup2) = *Table1)
((the location of *Cup3) = *Table2)





;;; ignore  MoveIt.km

(print "actions.km")

;;; ======================================================================
;;;  Must make sure classification is disabled during action processing:
;;; ======================================================================

(reset-kb)

(setq *LINEAR-PATHS* T)

(every Car has-definition
  (instance-of (Vehicle))
  (parts ((a Engine))))

(parts has (fluent-status (*Inertial-Fluent)))

(every Remove has
  (from ())
  (thing ())
  (del-list ((forall (the thing of Self)
		(:triple (Self from) parts It)))))

(new-situation)

(*MyVehicle has
  (instance-of (Vehicle))
  (parts (*Wheel *FurryDice *Elephant)))

(do-and-next (a Remove with (from (*MyVehicle)) (thing (*Wheel *FurryDice))))

;;; Constraint error in 1.4.5.8 and earlier
(print (the parts of *MyVehicle))

(setq *LINEAR-PATHS* NIL)
;;; ignore  aeronet.km

(print "alisa.km")

;;; Virus example from one of Bruce's students. Check that no infinite looping in
;;; the final test.

(reset-kb)

;(default-fluent-status *Inertial-Fluent)  - assumed already in KM

(Thing has
	(subclasses (TangibleThing IntangibleThing Event)))
(TangibleThing has
	(subclasses (Object Substance)))
(Place has
	(superclasses (IntangibleThing)))
(String has 
	(subclasses (PlacePreposition Boolean)))
(*inside has (instance-of (PlacePreposition)))
(*outside has (instance-of (PlacePreposition)))
(*on has (instance-of (PlacePreposition)))
(*above has (instance-of (PlacePreposition)))
(*within has (instance-of (PlacePreposition)))
(*surrounds has (instance-of (PlacePreposition)))
(*connected-to has (instance-of (PlacePreposition)))
(*yes has (instance-of (Boolean)))
(*no has (instance-of (Boolean)))
(every Place has
	(name ((must-be-a String)))
	(place-relation ((must-be-a PlacePreposition)))
	(reference-object ((must-be-a TangibleThing)))
	)

(every TangibleThing has
	(location ((a Place)))
	(externalsurface ((must-be-a Place with
				(place-relation ((*surrounds)))
				(reference-object ((Self)))
			))  )
	)

(every Event has
	(agent ((a TangibleThing)))
	(patient ((a TangibleThing)))	; duration??
	(theme ((a Thing)))
	)
(Barrier has
	(superclasses (Object)))

(every Barrier has
	(space1 ((a Place)))
	(space2 ((a Place)))  	; portal?? prevents??
	)

(Container has
	(superclasses (Barrier)))

(every Container has
	(space1 ((must-be-a Place with 
		(place-relation (*inside))
		(reference-object (Self))
		)) )
	(space2 ((must-be-a Place with 
		(place-relation ((*outside))) 
		(reference-object ((Self))) 
		)) )
	(contents ( (must-be-a TangibleThing with
			(location ((the space1 of Self)) )
			)))
	(capacity ((a Volume)))
	(sealed ((must-be-a Boolean)))
	)

(contents has
	(instance-of (Slot))
	(domain (Container))
	(range (TangibleThing))
	(cardinality(1-to-N))
	(inverse (contents-of))
	)

(contents-of has
	(instance-of (Slot))
	(domain (TangibleThing))
	(range (Container))
	(cardinality (N-to-1))
	(inverse (contents))
	)
(ProteinCoat has (superclasses (TangibleThing)))
(OuterProteinCoat has (superclasses (TangibleThing)))
(every ProteinCoat has
	(externalsurface ((a OuterProteinCoat))) )
(DNA has (superclasses (Substance)))
(Virus has (superclasses (Container)))
(every Virus has
	(contents ((a DNA)))
	(externalsurface ((a ProteinCoat)))
	)
(Lysosome has (superclasses (Container)))
(Cytoplasm has (superclasses (Container)))
(CellWall has (superclasses (Barrier)))

(every Cytoplasm has
	(contents ((a Lysosome)))
	)
(Cell has (superclasses (Container)))
(every Cell has
	(contents ((a Cytoplasm)))
	(externalsurface ((a CellWall)))
	)
(Move has (superclasses (Event)))
(every Move has
	(source ((the location of (the patient of (Self)))))
	(destination ((a Place)))
	(add-list ((:triple (the patient of (Self)) location (the
		destination of (Self)))))
	(del-list ((:triple (the patient of (Self)) location (the
		source of (Self)))))
	)
(Contain has (superclasses (Event)))
(every Contain has
	(theme ((a Container)))
	(patient ((a Thing)))
	(add-list ((:triple (the theme of (Self)) contents (the patient of
		(Self)) )))
	)	
(Enter has (superclasses (Move)))
(every Enter has
	(theme ((a Container)))
	(destination ((the space1 of (the theme of (Self)))))
	(subevents (
		(a Contain with
			(theme ((the theme of (Self))))
			(patient ((the patient of (Self)))) )
		) )
	)
(NotContain has (superclasses (Event)))
(every NotContain has
	(theme ((a Container)))
	(patient ((a Thing)))
	(del-list ((:triple (the theme of (Self)) contents (the patient of
		(Self)) )))
	)	
(Leave has (superclasses (Move)))
(every Leave has
	(theme ((a Container)))
	(source ((the space1 of (the theme of (Self)))))
	(subevents (
		(a NotContain with
			(theme ((the theme of (Self))))
			(patient ((the patient of (Self)))) )
		) )
	)
(Attach has (superclasses (Move)))

(every Attach has
	(theme ((a TangibleThing)))
	(destination ((must-be-a Place with
			(place-relation ((*connected-to)))
			(reference-object ((the theme of (Self))))
			)))
	)

(Cavity has (superclasses (Container)))
(every Cavity has
	(carved-from ((a TangibleThing)))
	(location ((a Place with
			(place-relation ((*within))) 
			(reference-object ((the carved-from of (Self)))))))
	)
(Sealing has (superclasses (Event)))
(every Sealing has
	(patient ((a Container)))
	(add-list ((:triple (the patient of (Self)) sealed (*yes))))
	(del-list ((:triple (the patient of (Self)) sealed (*no))))
	)
(VirusVesicle has (superclasses (Container)))
(every VirusVesicle has-definition
	(instance-of (Container))
	(sealed (*yes))
	(contents ((a Virus)) )
	)
(Swallow has (superclasses (Move)))
(every Swallow has
	(byproduct ((a Cavity with
			(carved-from ((the externalsurface of (the agent 
				of (Self))))))))
	(subevents (
	 	(a Enter with
			(theme ((the byproduct of (Self)))) 
			(patient ((the patient of (Self)))) )
		(a Sealing with
			(patient ((the byproduct of (Self)))) )
		) )
)		
(Endocytosis has (superclasses (Swallow)))
(every Endocytosis has
	(agent ((a Cell)))
	(patient ((a Thing)))
)
(ViralEndocytosis has (superclasses (Endocytosis)))
(every ViralEndocytosis has
	(agent ((a Cell)))
	(patient ((a Virus)))
)
(Remove has (superclasses (Move)))
(Uncover has (superclasses (Remove)))
(every Uncover has
	(theme ((a TangibleThing)))
	(patient ((the externalsurface of (the theme of (Self)))))
	(source ((a Place with
		(place-relation (*surrounds))
		(reference-object (the theme of (Self)))
		)))
	)
(LysosomalViralUncoating has (superclasses (Uncover)))
(every LysosomalViralUncoating has
	(theme ((a ProteinCoat)))
)
(CytoplasmalViralUncoating has (superclasses (Uncover)))
(every CytoplasmalViralUncoating has
	(theme ((a Virus)))
)
(*mycellwall has
	(instance-of (CellWall)))
(*mycytoplasm has
	(instance-of (Cytoplasm)))
(*mycell has
	(instance-of (Cell))
	(contents (*mycytoplasm))
	(externalsurface (*mycellwall))
	)
(*mylysosome has
	(instance-of (Lysosome))
	(location ((the space1 of (*mycell))))
)
(*spdna has
	(instance-of (DNA))
	)
(*spvirus has 
	(instance-of (Virus))
	(contents (*spdna))
	)
(*spvattach has
	(instance-of (Attach))
	(patient (*spvirus))
	(theme ((the externalsurface of (*mycell)))) )
(*spve has
	(instance-of (ViralEndocytosis))
	(agent (*mycell))
	(patient (*spvirus))
)
(*spvmove has
	(instance-of (Move))
	(patient (*spvirus))
	(destination ((the space2 of (*mylysosome))))
	)
(*spfuse has
	(instance-of (Swallow))
	(agent (*mylysosome))
	(patient (*spvirus))
	)
(*spv-lvu has
	(instance-of (LysosomalViralUncoating))
	(theme ((the externalsurface of (*spvirus))))
	)
(*spv-expel has
	(instance-of (Leave))
	(theme (*mylososome))
	)
(*spv-cvu has
	(instance-of (CytoplasmalViralUncoating))
	(theme (*spvirus))
)

(the location of *spdna)
(the contents of *spvirus)

;;; The ultimate test. Created infinite loop in beta35
((the location of *spdna) is
'(a Place with
  (instance-of (Place))
  (location-of (*spdna))
  (place-relation (*inside))
  (reference-object (*spvirus))
  (space1-of (*spvirus))))



;;; ignore  all-instances.km

(print "anand.km")

;;;; relevant KB files:
;;; change.km

(reset-kb)

(fail-noisily)

(Action has (superclasses (Event)))
(Change has (superclasses (Action)))

(agent has
   (instance-of (Slot))
   (subslots-of (actor))
   (domain (Change))
   (range (Thing))
   (cardinality (N-to-N))
   (inverse (agent-of)))

(patient has
   (instance-of (Slot))
   (subslots-of (actor))
   (domain (Change))
   (range (Thing))
   (cardinality (N-to-N))
   (inverse (patient-of)))

(instrument has
   (instance-of (Slot))
   (subslots-of (actor))
   (domain (Change))
   (range (Physical-object))
   (cardinality (N-to-N))
   (inverse (instrument-of)))

(affect has
   (instance-of (Slot))
   (domain (Change))
   (range (Affect))
   (cardinality (N-to-N))
   (inverse (affectOf))
   (subslots (majorAffects minorAffects)))

(force has
   (instance-of (Slot))
   (subslots-of (actor))
   (domain (Change))
   (range (Force))
   (cardinality (N-to-N))
   (inverse (force-of)))

(rate has
   (instance-of (Slot))
   (domain (Change))
   (range (Rate))
   (cardinality (N-to-1))
   (inverse (rate-of)))


(Change has (superclasses (Thing)))

(every Change has
   (patient ((a Thing)))
   (agent ((a PhysicalThing with
	      (capable-of (Self))
	      (agent-of ((a Exert-force with
			    (creates ((the force of Self)))
			    (patient ((the patient of Self)))))))))
   (force ((a Force with
	      (when ((a TimePeriod with 
			(overlaps ((the when of Self))))))
	      (created-by ((the agent of Self))))))
   (instrument ((a PhysicalThing with
		   (controlled-by ((the agent of Self))))))
   (rate ((a RateQuantity)))
   (subevents ((a Change with
		  (rate ((a RateQuantity with
			    (influences ((the rate of Self)))))))))
   (del-list ((forall (the affects of Self)
		      (:triple 
		       (the affectedThing of It)
		       (the affectedSlot of It)
		       (the oldValue of It)))))
   (add-list ((forall (the affects of Self)
		      (:triple 
		       (the affectedThing of It) 
		       (the affectedSlot of It)
		       (the newValue of It))))))

#|
; START TEMPORARY
(affectedThing has
  (instance-of (Slot))
  (situation-specific (t)))

(affectedSlot has
  (instance-of (Slot))
  (situation-specific (t)))

(newValue has
  (instance-of (Slot))
  (situation-specific (t)))
; END TEMPORARY
|#

;;; The following serves to reify an "Affect".  This should insulate
;;; components from future changes (if any) to the representation of
;;; add-lists and del-lists

(Affect has (superclasses (Thing)))
(every Affect has 
   (affectedThing ((a Thing)))
   (affectedSlot ((a Slot)))
   (oldValue ((a Thing)))
   (newValue ((a Thing))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; changepossession.km

;;(load-kb "change.km")
;;(load-kb "person.km")
;;(load-kb "possessedthing.km")

(ChangePossession has (superclasses (Change)))

(oldKeeper has
	(instance-of (Slot))
	(domain (ChangePossession))
	(range  (Person))
	(cardinality (N-to-1))
)

(newKeeper has
	(instance-of (Slot))
	(domain (ChangePossession))
	(range (Person))
	(cardinality (N-to-1))
)

(every ChangePossession has
	(patient ((a PossessedThing)))
	(oldKeeper ((a Person)))
	(newKeeper ((a Person)))
	(affects ((a Affect with
;			(affectedThing ((Self patient)))
			(affectedThing ((the patient of Self)))
			(affectedSlot (possessor))
			(oldValue  ((the oldKeeper of Self)))
			(newValue  ((the newKeeper of Self)))
		  )
		 )
	)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; possessedThing.km
;(load-kb "physicalthing.km")
(PhysicalThing has (superclasses (Thing)))

;(load-kb "person.km")

(PossessedThing has (superclasses (PhysicalThing)))
(Person has (superclasses (PhysicalThing)))

(possessor has
	(instance-of (Slot))
	(domain (PossessedThing))
	(range (Person))
	(cardinality (N-to-1))
)


(every PossessedThing has                ;;;;;<<<<<< the offending bit.
	(possessor ((a Person)))         ;;;;;<<<<<< remove this, and no bug
;	(possessor ((some Person)))      ;;;;; NEW!!! no longer necessary with supersituations not inheriting
)                                        


;;; Test script...

(possessor has (instance-of (Slot)) (situation-specific (t)))

(*anand has (instance-of (Person)))
(*bruce has (instance-of (Person)))
(*bicycle has (instance-of (PossessedThing)))
(new-situation)
(*bicycle has (possessor (*anand)))
(a ChangePossession with (patient (*bicycle))
	     (oldKeeper (*anand))
	     (newKeeper (*bruce))
)
(the del-list of (thelast ChangePossession))
(the add-list of (thelast ChangePossession))
(do-and-next (thelast ChangePossession))
(the possessor of *bicycle)
((the possessor of *bicycle) = *bruce)
(print "args.km")

;;; File: args.km
;;; Author: Peter Clark
;;; Purpose: Testing of multi-argument slot values

#|

	SIT1  -----------next----> SIT2
	      <------previous-----

	    ^ \		      ^ /
     cauzed-by cauzes    results-in  result-of
	     \  v          / v
		   ACTION 
|#

(reset-kb)
	
(next has 
  (instance-of (Slot))
  (inverse (previous))
  (inverse2 (cauzes)))

(cauzes has
  (instance-of (Slot))
  (inverse (cauzed-by))
  (inverse2 (next)))

(cauzed-by has
  (instance-of (Slot))
  (inverse (cauzes))
  (inverse2 (results-in)))

(results-in has
  (instance-of (Slot))
  (inverse (result-of))
  (inverse2 (cauzed-by)))

(result-of has
  (instance-of (Slot))
  (inverse (results-in))
  (inverse2 (previous)))

(previous has 
  (instance-of (Slot))
  (inverse (next))
  (inverse2 (result-of)))

(Sit1 has (next ((:args Sit2 Action1))))

(Action2 has (cauzes ((:args Sit3 Sit2))))

(Sit3 has (results-in ((:args Action3 Sit4))))

#|
RESULT:
(Sit1 has 
  (results-in ((:args Action1 Sit2)))
  (next ((:args Sit2 Action1))))

(Sit2 has 
  (next ((:args Sit3 Action2)))
  (results-in ((:args Action2 Sit3)))
  (cauzed-by ((:args Action1 Sit1)))
  (previous ((:args Sit1 Action1))))

(Sit3 has 
  (next ((:args Sit4 Action3)))
  (previous ((:args Sit2 Action2)))
  (cauzed-by ((:args Action2 Sit2)))
  (results-in ((:args Action3 Sit4))))

(Sit4 has 
  (cauzed-by ((:args Action3 Sit3)))
  (previous ((:args Sit3 Action3))))

(Action1 has 
  (cauzes ((:args Sit2 Sit1)))
  (result-of ((:args Sit1 Sit2))))

(Action2 has 
  (result-of ((:args Sit2 Sit3)))
  (cauzes ((:args Sit3 Sit2))))

(Action3 has 
  (cauzes ((:args Sit4 Sit3)))
  (result-of ((:args Sit3 Sit4))))
|#

((the results-in of Sit1) = (:args Action1 Sit2))
((the next of Sit1) = (:args Sit2 Action1))

((the next of Sit2) = (:args Sit3 Action2))
((the results-in of Sit2) = (:args Action2 Sit3))
((the cauzed-by of Sit2) = (:args Action1 Sit1))
((the previous of Sit2) = (:args Sit1 Action1))

((the next of Sit3) = (:args Sit4 Action3))
((the previous of Sit3) = (:args Sit2 Action2))
((the cauzed-by of Sit3) = (:args Action2 Sit2))
((the results-in of Sit3) = (:args Action3 Sit4))

((the cauzed-by of Sit4) = (:args Action3 Sit3))
((the previous of Sit4) = (:args Sit3 Action3))

((the cauzes of Action1) = (:args Sit2 Sit1))
((the result-of of Action1) = (:args Sit1 Sit2))

((the result-of of Action2) = (:args Sit2 Sit3))
((the cauzes of Action2) = (:args Sit3 Sit2))

((the cauzes of Action3) = (:args Sit4 Sit3))
((the result-of of Action3) = (:args Sit3 Sit4))

;;; ======================================================================
;;;		LIMITED TEST of inverse3
;;; ======================================================================
	
(reset-kb)

(next has 
  (instance-of (Slot))
  (inverse (previous))
  (inverse2 (cauzes)) 
(inverse3 (strength)))

(Sit1 has (next ((:args Sit2 Action1 lots))))

#|
(Sit1 has 
  (next ((:args Sit2 Action1 lots))))

(Sit2 has 
  (strength-of ((:args lots Action1 Sit1)))
  (cauzes-of ((:args Action1 Sit1 lots)))
  (previous ((:args Sit1 Action1 lots))))

(Action1 has 
  (cauzes ((:args Sit2 Sit1 lots))))
|#

((the next of Sit1) = (:args Sit2 Action1 lots))

((the strength-of of Sit2) = (:args lots Action1 Sit1))
((the cauzes-of of Sit2) = (:args Action1 Sit1 lots))
((the previous of Sit2) = (:args Sit1 Action1 lots))

((the cauzes of Action1) = (:args Sit2 Sit1 lots))

;;; ======================================================================
;;;		different form
;;; ======================================================================

((the1 of (:args 1 2 3)) = 1)
((the2 of (:args 1 2 3)) = 2)
((the3 of (:args 1 2 3)) = 3)

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

(every 727-Airplane has
  (number-of-parts-of-type (
     (:args Engine 2 test1)			
     (:args Wing 2 test2)
     (:args Seat 134 test3))))

;;; How many wings?
((forall (the number-of-parts-of-type of (a 727-Airplane))
  where  ((the1 of It) = Wing)
         (the2 of It)) = 2)

;;; How many seats?
((forall (the number-of-parts-of-type of (a 727-Airplane))
  where  ((the1 of It) = Seat)
         (the2 of It)) = 134)

(*My727 has
  (instance-of (727-Airplane)))

((the1 number-of-parts-of-type of *My727) = 
 (the1 of (the number-of-parts-of-type of *My727)))

((the2 number-of-parts-of-type of *My727) = 
 (the2 of (the number-of-parts-of-type of *My727)))

((the3 number-of-parts-of-type of *My727) = 
 (the3 of (the number-of-parts-of-type of *My727)))


;;; ------------------------------
;;;	 inverse12
;;; ------------------------------


(reset-kb)

(is-between has
  (instance-of (Slot))
  (domain (Spatial-Entity))
  (range (Spatial-Entity))
  (range2 (Spatial-Entity))
  (inverse (borders))
  (inverse12 (is-between)))

(Austin has
  (instance-of (Spatial-Entity))
  (is-between ((:args SanAntonio Dallas))))

((the is-between of Austin) includes (:args SanAntonio Dallas))
((the is-between of Austin) includes (:args Dallas SanAntonio))

((the1 borders of Dallas) = Austin)
((the1 borders of SanAntonio) = Austin)





(print "bioex.km")

;;; TEST-SUITE ENTRY FOR WORKING NOTE 18
;;; http://www.cs.utexas.edu/users/clarkp/working_notes

;;; File: bioex-classes.km
;;; Author: Peter Clark

;;; This file requires KM 1.4.0-beta33 or later 

(reset-kb)

;;; Declare some inverses...
(before has (instance-of (Slot)) (inverse (after)))
(cotemporal-with has (instance-of (Slot)) (inverse (cotemporal-with)))
(subevents has (instance-of (Slot)) (inverse (superevents)))

;;; [1] This ugly formatting simply prints out the before, cotemporal-with, and 
;;; after properties for each leaf subevent of the main event.
(every Event has
  (before ((the before of (the superevents of Self))))
  (cotemporal-with ((the cotemporal-with of (the superevents of Self))))
  (all-subevents ((the subevents of Self) 
                  (the all-subevents of (the subevents of Self))))
  (leaf-subevents ((allof (the all-subevents of Self) 
                    where (not (the subevents of It)))))
  (subevents ((the subevents of (the component-events of Self))))
  (description-of-leaf-subevents (
      (make-sentence
             (forall (the leaf-subevents of Self)                       ; [1]
                (:seq It "."
                      (if   (has-value (the before of It)) 
                       then (:seq It "is before" (the before of It) "."))
                      (if   (has-value (the cotemporal-with of It)) 
                       then (:seq It "is cotemporal with" (the cotemporal-with of It) "."))
                      (if   (has-value (the after of It)) 
                       then (:seq It "is after" (the after of It) "."))
                      (format nil "~%")))))))

;;; Being lazy over the taxonomy here...
(Virus-Visiting has (superclasses (Event)))
(Invading has (superclasses (Event)))
(Delivering has (superclasses (Event)))
(Fusing has (superclasses (Breaking)))
(Coalescing has (superclasses (Event)))
(Piercing has (superclasses (Event)))
(Arriving has (superclasses (Event)))
(Breaking has (superclasses (Event)))
(Entering has (superclasses (Event)))
(Moving has (superclasses (Event)))
(Attaching has (superclasses (Event)))
(Creating has (superclasses (Event)))
(Inserting has (superclasses (Event)))

;;; ----------------------------------------
;;;       VIRUS VISITING (composition)
;;; ----------------------------------------

;;; [1] is a slightly cumbersome way of saying the two Arrivings (subevents of
;;;     the Invading and Delivering respectively) are coreferential.
;;; [2] We wish to say that the generic Breaking in the Invading is (here) a special
;;;     way of breaking into something, namely a Fusing. Here we rely on KM's
;;;     set unification mechanism to appropriately unify the Fusing (here) with the
;;;     Breaking (inherited from Invading).
(every Virus-Visiting has
  (agent ((a Virus with
             (container-wall ((a Viral-Envelope)))
             (contents ((a Capsid)))
             (attachments ((a Transmembrane))))))
  (patient ((a Cell with
              (container-wall ((a Cell-Membrane)))
              (contents ((a Cytoplasm))))))
  (component-events (
    (a Invading with
      (agent ((the Capsid contents of (the Virus agent of Self))))
      (patient ((the Cell patient of Self)))
      (barrier ((the container-wall of (the Cell patient of Self))))
      (subevents (
        (the Arriving subevents of (the Delivering component-events of Self))  ; [1]
        (a Fusing)                                                             ; [2]
        (a Entering with
          (cotemporal-with ((the Moving subevents of 
                              (the Delivering component-events of Self))))))))
    (a Delivering with
      (agent ((the Virus agent of Self)))
      (package ((the Capsid contents of (the Virus agent of Self))))
      (recipient ((the Cell patient of Self)))
      (subevents (
        (the Arriving subevents of (the Invading component-events of Self))    ; [1]
        (a Moving with
          (cotemporal-with ((the Entering subevents of 
                              (the Invading component-events of Self)))))))))))

;;; ----------------------------------------
;;;       INVADING
;;; ----------------------------------------

(every Invading has
  (agent ((a Thing)))
  (patient ((a Thing)))
  (barrier ((a Thing with
              (surrounds ((the patient of Self))))))
  (subevents (
    (a Arriving with
      (agent ((the agent of Self)))
      (location ((the patient of Self)))
      (before ((the Breaking subevents of Self))))
    (a Breaking with
      (agent ((the agent of Self)))
      (patient ((the barrier of Self)))
      (before ((the Entering subevents of Self))))
    (a Entering with
      (agent ((the agent of Self)))
      (patient ((the patient of Self)))))))

;;; ----------------------------------------
;;;       DELIVERING
;;; ----------------------------------------

(every Delivering has
  (agent ((a Thing)))
  (package ((a Thing)))
  (recipient ((a Thing)))
  (subevents (
    (a Arriving with
      (agent ((the agent of Self)))
      (destination ((the recipient of Self)))
      (before ((the Moving subevents of Self))))
    (a Moving with
      (agent ((the agent of Self)))
      (patient ((the package of Self)))
      (destination ((the recipient of Self)))))))

;;; ----------------------------------------
;;;       FUSING
;;; ----------------------------------------

(every Fusing has
  (agent ((a Thing)))
  (patient ((a Thing)))         ; the barrier
  (subevents (
    (a Attaching with
      (agent ((the agent of Self)))
      (patient ((the patient of Self)))
      (before ((the Piercing subevents of Self))))
    (a Piercing with
      (agent ((the agent of Self)))
      (patient ((the container-wall of (the patient of Self))))
      (before ((the Coalescing subevents of Self))))
    (a Coalescing with
      (agent ((the agent of Self)))
      (patients ((the agent of Self) (the patient of Self)))))))

;;; ----------------------------------------
;;;       PIERCING
;;; ----------------------------------------

(every Piercing has
  (agent ((a Thing)))
  (patient ((a Thing)))
  (instrument ((a Thing)))                      ; a pointy thing
  (subevents (
    (a Creating with
      (agent ((the agent of Self)))
      (created ((a Portal with
                  (part-of ((the patient of Self))))))
      (instrument ((the instrument of Self)))
      (cotemporal-with ((the Inserting subevents of Self))))
    (a Inserting with
      (agent ((the agent of Self)))
      (instrument ((the instrument of Self)))
      (patient ((the patient of Self)))))))

;;; --- end ---
\end{verbatim}

;;; ======================================================================
;;;			TEST - Rather crude use of text string testing!
;;; ======================================================================

;; In fact, all the below summaries are incomplete due to inference incompleteness with inverses. 
;;; Really, we should explore all branches, to ensure inverses are installed and THEN ask the query. 
;;; Let's do that.

#|
((the description-of-leaf-subevents of (a Virus-Visiting)) =
"The arriving. The arriving is before the moving the fusing.
The entering. The entering is cotemporal with the moving.
The moving. The moving is cotemporal with the entering. The moving is after the arriving.
The attaching. The attaching is before the piercing the entering.
The coalescing. The coalescing is before the entering.
The creating. The creating is before the coalescing the entering. The creating is cotemporal with the inserting.
The inserting. The inserting is before the coalescing the entering. The inserting is cotemporal with the creating. 
.")
|#

(_X == (a Virus-Visiting))

(forall (the leaf-subevents of _X)		; precompute all inverses
 (:set (the before of It) (the cotemporal of It) (the after of It)))

#|
((the description-of-leaf-subevents of _X) =
"The arriving. The arriving is before the moving the fusing.
The entering. The entering is cotemporal with the moving. The entering is after the fusing the attaching the coalescing the piercing the creating the inserting.
The moving. The moving is cotemporal with the entering. The moving is after the arriving.
The attaching. The attaching is before the piercing the entering.
The coalescing. The coalescing is before the entering. The coalescing is after the piercing the creating the inserting.
The creating. The creating is before the coalescing the entering. The creating is cotemporal with the inserting.
The inserting. The inserting is before the coalescing the entering. The inserting is cotemporal with the creating. 
.")
|#
;;; ======================================================================

;;; File: bioex-prototypes.km
;;; Author: Peter Clark

;;; This file requires KM 1.4.0-beta33 or later 

(reset-kb)

;;; Declare some inverses...
(before has (instance-of (Slot)) (inverse (after)))
(cotemporal-with has (instance-of (Slot)) (inverse (cotemporal-with)))
(subevents has (instance-of (Slot)) (inverse (superevents)))

;;; [1] This ugly formatting simply prints out the before, cotemporal-with, and 
;;; after properties for each leaf subevent of the main event.
(every Event has
  (before ((the before of (the superevents of Self))))
  (cotemporal-with ((the cotemporal-with of (the superevents of Self))))
  (all-subevents ((the subevents of Self) 
                  (the all-subevents of (the subevents of Self))))
  (leaf-subevents ((allof (the all-subevents of Self) 
                    where (not (the subevents of It)))))
  (subevents ((the subevents of (the component-events of Self))))
  (description-of-leaf-subevents (
      (make-sentence
             (forall (the leaf-subevents of Self)                       ; [1]
                (:seq It "."
                      (if   (has-value (the before of It)) 
                       then (:seq It "is before" (the before of It) "."))
                      (if   (has-value (the cotemporal-with of It)) 
                       then (:seq It "is cotemporal with" (the cotemporal-with of It) "."))
                      (if   (has-value (the after of It)) 
                       then (:seq It "is after" (the after of It) "."))
                      (format nil "~%")))))))

;;; Being lazy over the taxonomy here...
(Virus-Visiting has (superclasses (Event)))
(Invading has (superclasses (Event)))
(Delivering has (superclasses (Event)))
(Fusing has (superclasses (Breaking)))
(Coalescing has (superclasses (Event)))
(Piercing has (superclasses (Event)))
(Arriving has (superclasses (Event)))
(Breaking has (superclasses (Event)))
(Entering has (superclasses (Event)))
(Moving has (superclasses (Event)))
(Attaching has (superclasses (Event)))
(Creating has (superclasses (Event)))
(Inserting has (superclasses (Event)))

;;; ----------------------------------------
;;;       VIRUS VISITING (composition)
;;; ----------------------------------------

(a-prototype Virus-Visiting)

;;; Introduce the objects into the prototype:
(a Virus with
  (container-wall ((a Viral-Envelope)))
  (contents ((a Capsid)))
  (attachments ((a Transmembrane))))

(a Cell with
  (container-wall ((a Cell-Membrane)))
  (contents ((a Cytoplasm))))

((the Virus-Visiting) has
  (agent ((the Virus)))
  (patient ((the Cell)))
  (component-events (
    (a Invading with
      (agent ((the Capsid)))
      (patient ((the Cell)))
      (barrier ((the Cell-Membrane))))
    (a Delivering with
      (agent ((the Virus)))
      (package ((the Capsid)))
      (recipient ((the Cell)))))))

((the Invading) has (subevents ((a Arriving) (a Breaking) (a Entering))))
((the Delivering) has (subevents ((a Arriving) (a Moving))))

;;; The Arrivings are coreferential
((the Arriving subevents of (the Invading)) == 
                (the Arriving subevents of (the Delivering)))

((the Entering) has
   (cotemporal-with ((the Moving))))

;;; In this case, the breaking occurs via fusing
((the Breaking) == (a Fusing))

(end-prototype)

;;; ----------------------------------------
;;;       INVADING
;;; ----------------------------------------

(a-prototype Invading)

((the Invading) has
  (agent ((a Thing)))
  (patient ((a Thing)))
  (barrier ((a Thing with
              (surrounds ((the patient of Self))))))
  (subevents (
    (a Arriving with
      (agent ((the agent of Self)))
      (location ((the patient of Self)))
      (before ((the Breaking subevents of Self))))
    (a Breaking with
      (agent ((the agent of Self)))
      (patient ((the barrier of Self)))
      (before ((the Entering subevents of Self))))
    (a Entering with
      (agent ((the agent of Self)))
      (patient ((the patient of Self)))))))

(end-prototype)

;;; ----------------------------------------
;;;       DELIVERING
;;; ----------------------------------------

(a-prototype Delivering)

((the Delivering) has
  (agent ((a Thing)))
  (package ((a Thing)))
  (recipient ((a Thing)))
  (subevents (
    (a Arriving with
      (agent ((the agent of Self)))
      (destination ((the recipient of Self)))
      (before ((the Moving subevents of Self))))
    (a Moving with
      (agent ((the agent of Self)))
      (patient ((the package of Self)))
      (destination ((the recipient of Self)))))))

(end-prototype)

;;; ----------------------------------------
;;;       FUSING
;;; ----------------------------------------

(a-prototype Fusing)

((the Fusing) has
  (agent ((a Thing)))
  (patient ((a Thing)))         ; the barrier
  (subevents (
    (a Attaching with
      (agent ((the agent of Self)))
      (patient ((the patient of Self)))
      (before ((the Piercing subevents of Self))))
    (a Piercing with
      (agent ((the agent of Self)))
      (patient ((the container-wall of (the patient of Self))))
      (before ((the Coalescing subevents of Self))))
    (a Coalescing with
      (agent ((the agent of Self)))
      (patients ((the agent of Self) (the patient of Self)))))))

(end-prototype)

;;; ----------------------------------------
;;;       PIERCING
;;; ----------------------------------------

(a-prototype Piercing)

((the Piercing) has
  (agent ((a Thing)))
  (patient ((a Thing)))
  (instrument ((a Thing)))                      ; a pointy thing
  (subevents (
    (a Creating with
      (agent ((the agent of Self)))
      (created ((a Portal with
                  (part-of ((the patient of Self))))))
      (instrument ((the instrument of Self)))
      (cotemporal-with ((the Inserting subevents of Self))))
    (a Inserting with
      (agent ((the agent of Self)))
      (instrument ((the instrument of Self)))
      (patient ((the patient of Self)))))))

(end-prototype)

;;; --- end ---

;;; ======================================================================
;;;			TEST - Rather crude use of text string testing!
;;; ======================================================================

;; In fact, all the below summaries are incomplete due to inference incompleteness with inverses. 
;;; Really, we should explore all branches, to ensure inverses are installed and THEN ask the query. 
;;; Let's do that.

#|
((:set 
"The entering. The entering is cotemporal with the moving. The entering is after the fusing.
The arriving. The arriving is before the moving the fusing.
The moving. The moving is cotemporal with the entering. The moving is after the arriving.
The attaching. The attaching is before the piercing the entering.
The coalescing. The coalescing is before the entering. The coalescing is after the piercing.
The creating. The creating is before the coalescing the entering. The creating is cotemporal with the inserting.
The inserting. The inserting is before the coalescing the entering. The inserting is cotemporal with the creating. 
."
"The entering. The entering is cotemporal with the moving. The entering is after the piercing the fusing.
The arriving. The arriving is before the moving the fusing.
The moving. The moving is cotemporal with the entering. The moving is after the arriving.
The attaching. The attaching is before the piercing the entering.
The coalescing. The coalescing is before the entering. The coalescing is after the piercing.
The creating. The creating is before the coalescing the entering. The creating is cotemporal with the inserting.
The inserting. The inserting is before the coalescing the entering. The inserting is cotemporal with the creating. 
."
"The arriving. The arriving is before the fusing the moving.
The entering. The entering is cotemporal with the moving. The entering is after the fusing the piercing.
The moving. The moving is cotemporal with the entering. The moving is after the arriving.
The attaching. The attaching is before the piercing the entering.
The coalescing. The coalescing is before the entering. The coalescing is after the piercing.
The creating. The creating is before the coalescing the entering. The creating is cotemporal with the inserting.
The inserting. The inserting is before the coalescing the entering. The inserting is cotemporal with the creating. 
."
"The arriving. The arriving is before the fusing the moving.
The entering. The entering is cotemporal with the moving. The entering is after the fusing.
The moving. The moving is cotemporal with the entering. The moving is after the arriving.
The attaching. The attaching is before the piercing the entering.
The coalescing. The coalescing is before the entering. The coalescing is after the piercing.
The creating. The creating is before the coalescing the entering. The creating is cotemporal with the inserting.
The inserting. The inserting is before the coalescing the entering. The inserting is cotemporal with the creating. 
.")

)
includes (the description-of-leaf-subevents of (a Virus-Visiting)))
|#

(_X == (a Virus-Visiting))

(forall (the leaf-subevents of _X)		; precompute all inverses
 (:set (the before of It) (the cotemporal of It) (the after of It)))

#|
((the description-of-leaf-subevents of _X) =
"The arriving. The arriving is before the fusing the moving.
The entering. The