Otherware/Otherware_1_SB_Development.iso/mac/misc/demo/clips.sit/MAB.CLP

Text File | 1988-04-29 | 8.2 KB | 318 lines

;;;======================================================
;;;   Monkees and Bannanas Sample Problem
;;;
;;;     This is an extended version of a
;;;     rather common AI planning problem.
;;;     The point is for the monkee to find
;;;     and eat some bannanas.
;;;
;;;     To execute, merely load, reset and run.
;;;======================================================


;(defrelation monkey (?location ?on-top-of ?holding))
;(defrelation object (?name ?location ?on-top-of ?weight))
;(defrelation chest (?name ?contents ?unlocked-by))
;(defrelation goal-is-to (?action $?arguments))

;;;*************************
;;;* chest unlocking rules *
;;;*************************

(defrule unlock-chest-to-hold-object ""
  (goal-is-to holds ?obj)
  (chest ?chest ?obj ?)
  (not (goal-is-to unlock ?chest))
  =>
  (assert (goal-is-to unlock ?chest)))

(defrule unlock-chest-to-move-object ""
  (goal-is-to move ?obj ?)
  (chest ?chest ?obj ?)
  (not (goal-is-to unlock ?chest))
  =>
  (assert (goal-is-to unlock ?chest)))

(defrule hold-chest-to-put-on-floor ""
  (goal-is-to unlock ?chest)
  (object ?chest ? ~floor light)
  (monkey ? ? ~?chest)
  (not (goal-is-to holds ?chest))
  =>
  (assert (goal-is-to holds ?chest)))

(defrule put-chest-on-floor ""
  (goal-is-to unlock ?chest)
  ?f1 <- (monkey ?place ?on ?chest)
  ?f2 <- (object ?chest held held light)
  =>
  (printout t "Monkey throws " ?chest " off " ?on " onto floor." t)
  (retract ?f1 ?f2)
  (assert (monkey ?place ?on blank))
  (assert (object ?chest ?place floor light)))

(defrule get-key-to-unlock ""
  (goal-is-to unlock ?obj)
  (object ?obj ? floor ?)
  (chest ?obj ? ?key)
  (monkey ? ? ~?key)
  (not (goal-is-to holds ?key))
  =>
  (assert (goal-is-to holds ?key)))

(defrule move-to-chest-with-key ""
  (goal-is-to unlock ?chest)
  (monkey ?mplace ? ?key)
  (object ?chest ?cplace&~?mplace floor ?)
  (chest ?chest ? ?key)
  (not (goal-is-to walk-to ?cplace))
  =>
  (assert (goal-is-to walk-to ?cplace)))

(defrule unlock-chest-with-key ""
  ?f1 <- (goal-is-to unlock ?chest)
  ?f2 <- (chest ?chest ?contents ?key)
  (object ?chest ?place ?on ?)
  (monkey ?place ?on ?key)
  =>
  (printout t "Monkey opens chest with " ?key " revealing " ?contents t)
  (retract ?f1 ?f2)
  (assert (chest ?chest nothing ?key))
  (assert (object ?contents ?place ?chest light)))

;;;***********************
;;;* process hold object *
;;;***********************

(defrule use-ladder-to-hold ""
  (goal-is-to holds ?obj)
  (object ?obj ?place ceiling light)
  (not (object ladder ?place ? ?))
  (not (goal-is-to move ladder ?place))
  =>
  (assert (goal-is-to move ladder ?place)))

(defrule climb-ladder-to-hold ""
  (goal-is-to holds ?obj)
  (object ?obj ?place ceiling light)
  (object ladder ?place floor ?)
  (monkey ? ~ladder ?)
  (not (goal-is-to on ladder))
  =>
  (assert (goal-is-to on ladder)))

(defrule grab-object-from-ladder ""
  ?f1 <- (goal-is-to holds ?obj)
  ?f2 <- (object ?obj ?place ceiling light)
  (object ladder ?place ? ?)
  ?f3 <- (monkey ?place ladder blank)
  =>
  (printout t "Monkey grabs the " ?obj t)
  (retract ?f1 ?f2 ?f3)
  (assert (object ?obj held held light))
  (assert (monkey ?place ladder ?obj)))

(defrule climb-to-hold ""
  (goal-is-to holds ?obj)
  (object ?obj ?place ?on&~ceiling light)
  (monkey ?place ~?on ?)
  (not (goal-is-to on ?on))
  =>
  (assert (goal-is-to on ?on)))

(defrule walk-to-hold ""
  (goal-is-to holds ?obj)
  (object ?obj ?place ~ceiling light)
  (monkey ~?place ? ?)
  (not (goal-is-to walk-to ?place))
  =>
  (assert (goal-is-to walk-to ?place)))

(defrule drop-to-hold ""
  (goal-is-to holds ?obj)
  (object ?obj ?place ?on light)
  (monkey ?place ?on ~blank)
  (not (goal-is-to holds blank))
  =>
  (assert (goal-is-to holds blank)))

(defrule grab-object ""
  ?f1 <- (goal-is-to holds ?obj)
  ?f2 <- (object ?obj ?place ?on light)
  ?f3 <- (monkey ?place ?on blank)
  =>
  (printout t "Monkey grabs the " ?obj t)
  (retract ?f1 ?f2 ?f3)
  (assert (object ?obj held held light))
  (assert (monkey ?place ?on ?obj)))

;;;**************************
;;;* move object to a place *
;;;**************************

(defrule hold-object-to-move ""
  (goal-is-to move ?obj ?place)
  (object ?obj ~?place ? light)
  (monkey ? ? ~?obj)
  (not (goal-is-to holds ?obj))
  =>
  (assert (goal-is-to holds ?obj)))

(defrule move-object-to-place ""
  (goal-is-to move ?obj ?place)
  (monkey ~?place ? ?obj)
  (not (goal-is-to walk-to ?place))
  =>
  (assert (goal-is-to walk-to ?place)))

(defrule drop-object-once-moved ""
  ?f1 <- (goal-is-to move ?obj ?place)
  ?f2 <- (monkey ?place ?on ?obj)
  ?f3 <- (object ?obj ? ? light)
  =>
  (printout t "Monkey drops the " ?obj "." t)
  (retract ?f1 ?f2 ?f3)
  (assert (monkey ?place ?on blank))
  (assert (object ?obj ?place floor light)))

(defrule already-moved-object ""
  ?f1 <- (goal-is-to move ?obj ?place)
  (object ?obj ?place ? ?)
  =>
  (retract ?f1))

;;;*************************
;;;* process walk-to place *
;;;*************************

(defrule already-at-place ""
  ?f1 <- (goal-is-to walk-to ?place)
  (monkey ?place ? ?)
  =>
  (retract ?f1))

(defrule get-on-floor-to-walk ""
  (goal-is-to walk-to ?place)
  (monkey ~?place ~floor ?)
  (not (goal-is-to on floor))
  =>
  (assert (goal-is-to on floor)))

(defrule walk-holding-nothing ""
  ?f1 <- (goal-is-to walk-to ?place)
  ?f2 <- (monkey ~?place floor blank)
  =>
  (printout t "Monkey walks to " ?place t)
  (retract ?f1 ?f2)
  (assert (monkey ?place floor blank)))

(defrule walk-holding-object ""
  ?f1 <- (goal-is-to walk-to ?place)
  ?f2 <- (monkey ~?place floor ?obj&~blank)
  =>
  (printout t "Monkey walks to " ?place " holding " ?obj t)
  (retract ?f1 ?f2)
  (assert (monkey ?place floor ?obj)))

(defrule drop-object ""
  ?f1 <- (goal-is-to holds blank)
  ?f2 <- (monkey ?place ?on ?obj&~blank)
  ?f3 <- (object ?obj held held light)
  =>
  (printout t "Monkey drops " ?obj t)
  (retract ?f1 ?f2 ?f3)
  (assert (object ?obj ?place ?on light))
  (assert (monkey ?place ?on blank)))

;;;*************************
;;;* process get on object *
;;;*************************

(defrule jump-onto-floor ""
  ?f1 <- (goal-is-to on floor)
  ?f2 <- (monkey ?at ?on&~floor ?obj)
  =>
  (printout t "Monkey jumps off " ?on " onto the floor." t)
  (retract ?f1 ?f2)
  (assert (monkey ?at floor ?obj)))

(defrule walk-to-place-to-climb ""
  (goal-is-to on ?obj)
  (object ?obj ?place ? ?)
  (monkey ~?place ? ?)
  (not (goal-is-to walk-to ?place))
  =>
  (assert (goal-is-to walk-to ?place)))

(defrule drop-to-climb ""
  (goal-is-to on ?obj)
  (object ?obj ?place ? ?)
  (monkey ?place ? ~blank)
  (not (goal-is-to holds blank))
  =>
  (assert (goal-is-to holds blank)))

(defrule climb-indirectly ""
  (goal-is-to on ?obj)
  (object ?obj ?place ?on ?)
  (monkey ?place ~?on&~?obj blank)
  (not (goal-is-to on ?on))
  =>
  (assert (goal-is-to on ?on)))

(defrule climb-directly ""
  ?f1 <- (goal-is-to on ?obj)
  (object ?obj ?place ?on ?)
  ?f2 <- (monkey ?place ?on blank)
  =>
  (printout t "Monkey climbs onto " ?obj t)
  (retract ?f1 ?f2)
  (assert (monkey ?place ?obj blank)))

(defrule already-on-object ""
  ?f1 <- (goal-is-to on ?obj)
  (monkey ? ?obj ?)
  =>
  (retract ?f1))

;;;**********************
;;;* process eat object *
;;;**********************

(defrule hold-to-eat ""
  (goal-is-to eat ?obj)
  (monkey ? ? ~?obj)
  (not (goal-is-to holds ?obj))
  =>
  (assert (goal-is-to holds ?obj)))

(defrule satisfy-hunger ""
  ?f1 <- (goal-is-to eat ?obj)
  ?f2 <- (monkey ?place ?on ?obj)
  ?f3 <- (object ?obj ? ? ?)
  =>
  (printout t "Monkey eats the " ?obj "." t)
  (retract ?f1 ?f2 ?f3)
  (assert (monkey ?place ?on blank)))

;;;*****************
;;;* initial-state *
;;;*****************

(defrule startup ""
  =>
  (assert (monkey t5-7 green-couch blank))
  (assert (object green-couch t5-7 floor heavy))
  (assert (object red-couch t2-2 floor heavy))
  (assert (object big-pillow t2-2 red-couch light))
  (assert (object red-chest t2-2 big-pillow light))
  (assert (chest red-chest ladder red-key))
  (assert (object blue-chest t7-7 ceiling light))
  (assert (chest blue-chest bananas blue-key))
  (assert (object blue-couch t8-8 floor heavy))
  (assert (object green-chest t8-8 ceiling light))
  (assert (chest green-chest blue-key red-key))
  (assert (object red-key t1-3 floor light))
  (assert (goal-is-to eat bananas)))