next up previous contents
Next: Sample Output From Up: Title Previous: Discussion

Sample Rules From COSINE

 

This appendix includes sample rules from the source code of COSINE for two selectors, three critics, one evaluator, one estimator, and one praiser, all from the cup radius parameter block for the wine glass design. All of the rules making up these agents are presented here. COSINE has other agents that are not included in this appendix.

The names of the agents as they are referred to in the rules are given in parantheses in the comments after the full name of the agents.

;----------------------------------
;cup radius stability selector (S1)
;----------------------------------
;design rules

(defrule S1-cr-from-br 
  ?par <- (param (name cr) (owner nil|S1) (val ?cr))
  (param (name br) (val ?br&~nil))
  (pref (agent S1) (list $?list))
  (test (neq (* ?br (first ?list)) ?cr))
  => 
  (bind ?newcr (* ?br (first ?list)))
  (modify ?par (val ?newcr) (owner S1))
  (say S1 Set cup radius value to ?newcr cm.))

;redesign rules

(defrule S1-re-cr-from-br (declare (salience 20))
  ?par <- (param (name cr) (owner S1) (val ?cr&~nil))
  (param (name br) (val ?br&~nil))
  (pref (agent S1) (list $?list))
  (test (neq (* ?br (first ?list)) ?cr))
  =>
  (bind ?newcr (* ?br (first ?list)))
  (modify ?par (val ?newcr) (owner S1))
  (say S1 Redesigned cup radius value to ?newcr cm.))

;conflict detection rules

(defrule S1-detect (declare (salience 10))
  (param (name cr) (val ?cr&~nil) (owner ?owner&~nil&~S1))
  (param (name br) (val ?br&~nil))
  (pref (agent S1) (list $?list))
  (test (> (/ (abs (- (* ?br (first ?list)) ?cr)) ?cr) 0.1))
  =>
  (assert (conflict (initiator S1) (partner ?owner)))
  (say S1 Conflict detected with (name ?owner) .))

(defrule S1-no-conflict (declare (salience 40))
  (param (name cr) (val ?cr&~nil) (owner ?owner&~nil&~S1))
  (param (name br) (val ?br&~nil))
  (pref (agent S1) (list $?list))
  (test (< (/ (abs (- (* ?br (first ?list)) ?cr)) ?cr) 0.1))
  ?cf <- (conflict (initiator S1) (partner ?owner))
  =>
  (retract ?cf)
  (say S1 Conflict with (name ?owner) resolved.))

;conflict resolution rules

(defrule S1-tell-alternative (declare (salience 30))
  ?msg <- (msg (to S1) (from ?from) (primitive ask) 
	       (subject alternative) (param1 v1))
  ?pref <- (pref (agent S1) (list $?list))
  (param (name cr))
  (test (> (length ?list) 1))
  =>
  (modify ?pref (list (rest$ ?list)))
  (say S1 Using alternative value.)
  (retract ?msg))

(defrule S1-no-alternative (declare (salience 30))
  ?msg <- (msg (to S1) (from ?from) (primitive ask) 
	       (subject alternative) (param1 v1))
  (pref (agent S1) (list $?list))
  ?param <- (param (name cr))
  (test (= (length ?list) 1))
  =>
  (say S1 No alternative values.)
  (assert (msg (from S1) (to ?from) (primitive ask) (subject relax) 
	       (param1 v1)))
  (say S1 Ask (name ?from) to relax constraints.)
  (retract ?msg))

(defrule S1-ask-alternative (declare (salience 30))
  (conflict (initiator S1) (partner ?partner))
  =>
  (assert (msg (from S1) (to ?partner) (primitive ask) 
	       (subject alternative) (param1 v1)))
  (say S1 Ask (name ?partner) for an alternative value.))

(defrule S1-dont-care (declare (salience 30))
  ?msg <- (msg (to S1) (from ?from) (primitive tell) 
	       (subject dont-care) (param1 v1))
  ?conf <- (conflict (initiator S1) (partner ?from))
  =>
  (retract ?msg)
  (retract ?conf)
  (assert (msg (from S1) (to ?from) (primitive ask) (subject retract) 
	       (param1 v1)))
  (say S1 Ask (name ?from) to retract the value of cup radius.)
  (say S1 Conflict with (name ?from) resolved.))



;--------------------------------------
;cup radius value stability critic (C1)
;--------------------------------------
;criticism and conflict detection rules

(defrule C1-cup-unstable (declare (salience 10))
  (param (name cr) (val ?cr&~nil) (owner ?owner))
  (param (name br) (val ?br&~nil))
  (pref (agent C1) (list $?list))
  (test (> (- ?cr ?br) (first ?list)))
  =>
  (assert (ct (of v1) (owner C1) (pov stability) (body too-high)))
  (say C1 Conflict detected with (name ?owner) .)
  (assert (conflict (initiator C1) (partner ?owner)))
  (say C1 Criticism asserted. 
       Cup radius value is too high from stability pov.))

(defrule C1-cup-stable (declare (salience 40))
  (param (name cr) (val ?cr&~nil) (owner ?owner))
  (param (name br) (val ?br&~nil))
  (pref (agent C1) (list $?list))
  (test (<= (- ?cr ?br) (first ?list)))
  ?ct <- (ct (of v1) (owner C1) (pov stability) (body too-high))
  ?cf <- (conflict (initiator C1) (partner ?owner))
  =>
  (retract ?ct)
  (say C1 Criticism retracted. 
       Cup radius value is not too high from stability pov anymore.)
  (retract ?cf)
  (say C1 Conflict with (name ?owner) resolved.))

;conflict resolution rules

(defrule C1-ask-alternative (declare (salience 30))
  (ct (of v1) (owner C1) (body ?tag))
  (param (name cr) (owner ?owner))
  =>
  (assert (msg (from C1) (to ?owner) (primitive ask) 
	       (subject alternative) (param1 v1)))
  (say C1 Ask (name ?owner) for an alternative value.))

(defrule C1-relax (declare (salience 30))
  ?msg <- (msg (to C1) (from ?from) (primitive ask) (subject relax) 
	       (param1 v1))
  ?pref <- (pref (agent C1) (list $?list))
  (test (> (length ?list) 1))
  =>
  (modify ?pref (list (rest$ ?list)))
  (say C1 Constraint relaxed.)
  (retract ?msg))

(defrule C1-no-relaxation (declare (salience 30))
  ?msg <- (msg (to C1) (from ?from) (primitive ask) (subject relax) 
	       (param1 v1))
  (pref (agent C1) (list $?list))
  (test (= (length ?list) 1))
  =>
  (assert (msg (from C1) (to ?from) (primitive tell) (subject relax) 
	       (param1 v1) (param2 none)))
  (say C1 Tell (name ?from) that no relaxation is possible.)
  (retract ?msg))

(defrule C1-dont-care (declare (salience 30))
  ?msg <- (msg (to C1) (from ?from) (primitive tell) 
	       (subject dont-care) (param1 v1))
  ?conf <- (conflict (initiator C1) (partner ?from))
  ?ct <- (ct (of v1) (owner C1))
  =>
  (retract ?msg)
  (assert (msg (from C1) (to ?from) (primitive ask) (subject retract) 
	       (param1 v1)))
  (say C1 Ask (name ?from) to retract the value of cup radius.)
  (retract ?conf)
  (retract ?ct)
  (say C1 Conflict with (name ?from) resolved.))

;-----------------------------------
;cup radius value volume critic (C2)
;-----------------------------------
;criticism and conflict detection rules

(defrule C2-cup-too-small (declare (salience 10))
  (param (name cr) (val ?cr&~nil) (owner ?owner))
  (pref (agent C2) (list $?list))
  (test (< (* 0.67 (pi) (* ?cr ?cr ?cr)) (first ?list)))
  =>
  (assert (conflict (initiator C2) (partner ?owner)))
  (say C2 Conflict detected with (name ?owner) .)
  (assert (ct (of v1) (owner C2) (pov volume) (body too-low)))
  (say C2 Criticism asserted. Cup radius value is too low from 
       volume pov.))

(defrule C2-cup-too-big (declare (salience 10))
  (param (name cr) (val ?cr&~nil) (owner ?owner))
  (pref (agent C2) (list $?list))
  (test (> (* 0.67 (pi) (* ?cr ?cr ?cr)) (second ?list)))
  =>
  (assert (conflict (initiator C2) (partner ?owner)))
  (say C2 Conflict detected with (name ?owner) .)
  (assert (ct (of v1) (owner C2) (pov volume) (body too-high)))
  (say C2 Criticism asserted. Cup radius value is too high from 
       volume pov.))

(defrule C2-cup-size-ok (declare (salience 40))
  (param (name cr) (val ?cr&~nil) (owner ?owner))
  (pref (agent C2) (list $?list))
  (test (>= (* 0.67 (pi) (* ?cr ?cr ?cr)) (first ?list)))
  (test (<= (* 0.67 (pi) (* ?cr ?cr ?cr)) (second ?list)))
  ?ct <- (ct (of v1) (owner C2) (pov volume) (body ?body))
  ?cf <- (conflict (initiator C2) (partner ?owner))
  =>
  (retract ?ct)
  (say C2 Criticism retracted. 
       Cup radius value is not ?body anymore from a volume pov. )
  (retract ?cf)
  (say C2 Conflict with (name ?owner) resolved.))

;conflict resolution rules

(defrule C2-ask-alternative (declare (salience 30))
  (ct (of v1) (owner C2) (body ?tag))
  (param (name cr) (owner ?owner))
  =>
  (assert (msg (from C2) (to ?owner) (primitive ask) 
	       (subject alternative) (param1 v1)))
  (say C2 Ask (name ?owner) for an alternative value.))

(defrule C2-no-relaxation (declare (salience 30))
  ?msg <- (msg (to C2) (from ?from) (primitive ask) (subject relax) 
	       (param1 v1))
  =>
  (assert (msg (from C1) (to ?from) (primitive tell) (subject relax) 
	       (param1 v1) (param2 none)))
  (say C1 Tell (name ?from) that no relaxation is possible.)
  (retract ?msg))

(defrule C2-dont-care (declare (salience 30))
  ?msg <- (msg (to C2) (from ?from) (primitive tell) 
	       (subject dont-care) (param1 v1))
  ?conf <- (conflict (initiator C2) (partner ?from))
  ?ct <- (ct (of v1) (owner C2))
  =>
  (retract ?msg)
  (assert (msg (from C2) (to ?from) (primitive ask) (subject retract) 
	       (param1 v1)))
  (say C2 Ask (name ?from) to retract the value of cup radius.)
  (retract ?conf)
  (retract ?ct)
  (say C2 Conflict with (name ?from) resolved.))

;------------------------------
;cup radius style selector (S2)
;------------------------------
;design rules

(defrule S2-default-cr-style
  ?par <- (param (name cr) (val nil))
  (pref (agent S2) (list $?list))
  =>
  (modify ?par (val (first ?list)) (owner S2))
  (say S2 Cup radius set to default value of (first ?list) cm.))

;redesign rules

(defrule S2-new-cr-style (declare (salience 20))
  ?par <- (param (name cr) (owner S2) (val ?cr&~nil))
  (pref (agent S2) (list $?list))
  (test (neq ?cr (first ?list)))
  =>
  (modify ?par (val (first ?list)) (owner S2))
  (say S2 Cup radius set to new value of (first ?list) cm.))

;conflict resolution rules

(defrule S2-dont-care (declare (salience 30))
  ?care <- (S2 dont care)
  ?msg <- (msg (to S2) (from ?from) (primitive ask) 
	       (subject alternative) (param1 v1))
  =>
  (retract ?care)
  (retract ?msg)
  (assert (msg (from S2) (to ?from) (primitive tell) 
	       (subject dont-care) (param1 v1)))
  (say S2 Tell (name ?from) that I don't care about value of 
       cup radius.))

(defrule S2-retract (declare (salience 30))
  ?msg <- (msg (to S2) (from ?from) (primitive ask) (subject retract) 
	       (param1 v1))
  ?par <- (param (name cr) (owner S2))
  ?pref <- (pref (agent S2))
  =>
  (retract ?msg)
  (modify ?par (val nil) (owner nil))
  (retract ?pref)
  (say S2 Value of cup radius retracted.))

(defrule S2-tell-alternative (declare (salience 30))
  ?msg <- (msg (to S2) (from ?from) (primitive ask) 
	       (subject alternative) (param1 v1))
  ?pref <- (pref (agent S2) (list $?list))
  (param (name cr))
  (test (> (length ?list) 1))
  =>
  (retract ?msg)
  (modify ?pref (list (rest$ ?list)))
  (say S2 Using alternative value.))

(defrule S2-no-alternative (declare (salience 30))
  (msg (to S2) (from ?from) (primitive ask) 
       (subject alternative) (param1 v1))
  (pref (agent S2) (list $?list))
  ?param <- (param (name cr))
  (test (= (length ?list) 1))
  =>
  (say S2 No alternative values.)
  (say S2 Switching to dont care mode.)
  (assert (S2 dont care))) 

;---------------------------------------
;cup radius value volume evaluator (Ev1)
;---------------------------------------
;evaluation rules

(defrule Ev1-rough-evaluate-good
  (param (name cr) (val ?cr&~nil))
  (pref (agent Ev1) (list $?list))
  ?eval <- (eval (of v1) (op ?op) (percentage ?per))
  (test (< (- (* 0.67 (pi) ?cr ?cr ?cr) (first ?list)) (second ?list)))
  (test (or (neq ?per good) (neq ?op eq)))
  (not (precision evaluation required))
  =>
  (modify ?eval (of v1) (owner Ev1) (pov volume) (op eq) 
	  (percentage good))
  (say Ev1 Evaluation asserted. Cup radius value is good from a 
       volume pov.))

(defrule Ev1-rough-evaluate-bad
  (param (name cr) (val ?cr&~nil))
  (pref (agent Ev1) (list $?list))
  ?eval <- (eval (of v1) (op ?op) (percentage ?per))
  (test (> (- (* 0.67 (pi) ?cr ?cr ?cr) (first ?list)) (second ?list)))
  (test (or (neq ?per bad) (neq ?op eq)))
  (not (precision evaluation required))
  =>
  (modify ?eval (of v1) (owner Ev1) (pov volume) (op eq) 
	  (percentage bad))
  (say Ev1 Evaluation asserted. Cup radius value is bad from a 
       volume pov.))

(defrule Ev1-precise-evaluate
  ?req <- (precision evaluation required)
  (param (name cr) (val ?cr&~nil))
  (pref (agent Ev1) (list $?list))
  ?eval <- (eval (of v1) (owner Ev1) (pov volume) (op ?op) 
		 (percentage ?oldper))
  =>
  (bind ?per (round (- 100 (* (/ (abs (- (* 0.67 (pi) ?cr ?cr ?cr) 
			   (first ?list))) (first ?list)) 100))))
  (if (neq ?oldper ?per) then 
    (modify ?eval (op eq) (percentage ?per))
    (say Ev1 Evaluation asserted. Cup radius value's quality is 
	 ?per percent.)))

;conflict resolution rules

(defrule Ev1-precision-required (declare (salience 30))
  ?msg <- (msg (to Ev1) (from ?from) (primitive ask) 
	       (subject precision) (param1 ev1))
  =>
  (retract ?msg)
  (assert (precision evaluation required))
  (say Ev1 Changing to precision evaluation mode.))

;-------------------------------------------------
;cup radius value evaluation precision critic (C3)
;-------------------------------------------------
;criticism and conflict detection rules

(defrule C3-imprecise-evaluation (declare (salience 10))
  (eval (of v1) (owner ?owner&~nil) (percentage ?per))
  (test (not (numberp ?per)))
  =>
  (assert (conflict (initiator C3) (partner ?owner)))
  (say C3 Conflict detected with (name ?owner) .)
  (assert (ct (of ev1) (owner C3) (pov precision) 
	      (body too-imprecise)))
  (say C3 Criticism asserted. Cup radius value evaluation is 
       too imprecise.))

(defrule C3-precise-evaluation (declare (salience 40))
  (eval (of v1) (owner ?owner&~nil) (percentage ?per))
  (test (numberp ?per))
  ?ct <- (ct (of ev1) (owner C3) (pov precision) 
	     (body too-imprecise))
  ?cf <- (conflict (initiator C3) (partner ?owner))
  =>
  (retract ?ct)
  (say C3 Criticism retracted. 
       Cup radius value evaluation is not imprecise anymore.)
  (retract ?cf)
  (say C3 Conflict with (name ?owner) resolved.))

;conflict resolution rules

(defrule C3-ask-precision (declare (salience 30))
  (ct (of ev1) (owner C3) (body too-imprecise))
  (eval (of v1) (owner ?owner) )
  =>
  (assert (msg (to ?owner) (from C3) (primitive ask) 
	       (subject precision) (param1 ev1)))
  (say C3 Ask (name ?owner) to offer a more precise evaluation.))

;----------------------------------------
;cup radius handleability estimator (Es1)
;----------------------------------------
;estimation rules

(defrule Es1-using-stem-length
  ?par <- (param (name cr) (est nil))
  (param (name sl) (val ?sl&~nil))
  (pref (agent Es1) (list $?list))
  =>
  (bind ?est (* (first ?list) ?sl))
  (modify ?par (est ?est) (estowner Es1))
  (say Es1 Cup radius estimated to be ?est cm.))

;reestimation rules

(defrule Es1-reusing-stem-length (declare (salience 20))
  ?par <- (param (name cr) (est ?est&~nil) (estowner Es1))
  (param (name sl) (val ?sl&~nil))
  (pref (agent Es1) (list $?list))
  (test (neq ?est (* (first ?list) ?sl)))
  =>
  (bind ?est (* (first ?list) ?sl))
  (modify ?par (est ?est) (estowner Es1))
  (say Es1 Cup radius re-estimated to be ?est cm.))

;conflict detection rules

(defrule Es1-detect (declare (salience 10))
  (param (name cr) (est ?cr&~nil) (estowner ?owner&~nil&~Es1))
  (param (name sl) (val ?sl&~nil))
  (pref (agent Es1) (list $?list))
  (test (> (/ (abs (- (* ?sl (first ?list)) ?cr)) ?cr) 0.1))
  =>
  (assert (conflict (initiator Es1) (partner ?owner)))
  (say Es1 Conflict detected with (name ?owner) .))

(defrule Es1-no-conflict (declare (salience 40))
  (param (name cr) (est ?cr&~nil) (estowner ?owner&~nil&~Es1))
  (param (name sl) (val ?sl&~nil))
  (pref (agent Es1) (list $?list))
  (test (< (/ (abs (- (* ?sl (first ?list)) ?cr)) ?cr) 0.1))
  ?cf <- (conflict (initiator Es1) (partner ?owner))
  =>
  (retract ?cf)
  (say Es1 Conflict with (name ?owner) resolved.))

;conflict resolution rules

(defrule Es1-ask-alternative (declare (salience 30))
  (conflict (initiator Es1) (partner ?partner))
  =>
  (assert (msg (from Es1) (to ?partner) (primitive ask) 
	       (subject alternative) (param1 es1)))
  (say Es1 Ask (name ?partner) for an alternative estimate.))

(defrule Es1-tell-alternative (declare (salience 30))
  ?msg <- (msg (to Es1) (from ?from) (primitive ask) 
	       (subject alternative) (param1 es1))
  ?pref <- (pref (agent Es1) (list $?list))
  (test (> (length ?list) 1))
  =>
  (retract ?msg)
  (modify ?pref (list (rest$ ?list)))
  (say Es1 Using alternative estimate.))

(defrule Es1-no-alternative (declare (salience 30))
  ?msg <- (msg (to Es1) (from ?from) (primitive ask) 
	       (subject alternative) (param1 es1))
  (pref (agent Es1) (list $?list))
  (test (= (length ?list) 1))
  =>
  (retract ?msg)
  (say Es1 No alternative estimates.))

;-----------------------------------
;cup radius value style praiser (P1)
;-----------------------------------
;praise rules

(defrule P1-cup-beautiful (declare (salience 10))
  (param (name cr) (val ?cr&~nil) (owner ?owner))
  (pref (agent P1) (list $?list))
  (test (and (> ?cr (first ?list)) (< ?cr (second ?list))))
  =>
  (assert (pr (of v1) (owner P1) (pov style) (body beautiful)))
  (say P1 Praise asserted. Cup radius value makes cup beautiful 
       from style pov.))

(defrule P1-cup-beautiful-no-more (declare (salience 10))
  (param (name cr) (val ?cr&~nil) (owner ?owner))
  (pref (agent P1) (list $?list))
  (test (or (< ?cr (first ?list)) (> ?cr (second ?list))))
  ?pr <- (pr (of v1) (owner P1))
  =>
  (retract ?pr)
  (say P1 Praise retracted. Cup radius value does not make the cup 
       beautiful from style pov anymore.))

;conflict detection rules

(defrule P1-detect (declare (salience 10))
  (pr (of v1) (owner P1))
  (ct (of v1) (owner ?owner) (pov style))
  =>
  (say P1 Conflict detected with (name ?owner) .)
  (assert (conflict (initiator P1) (partner ?owner))))

(defrule P1-no-conflict (declare (salience 40))
  ?cf <- (conflict (initiator P1) (partner ?partner))
  (not (ct (of v1) (owner ?partner) (pov style)))
  =>
  (retract ?cf)
  (say P1 Conflict with (name ?partner) resolved.))

;conflict resolution rules

(defrule P1-ask-removal (declare (salience 30))
  (conflict (initiator P1) (partner ?partner))
  =>
  (assert (msg (from P1) (to ?partner) (primitive ask) 
	       (subject retract) (param1 ct)))
  (say P1 Ask (name ?partner) to remove its criticism.))



Ilan Berker
Thu Apr 27 16:25:38 EDT 1995