Практическая разработка экспертных систем в среде CLIPS

;;;======================================================
;;;     Control Expert System of technological process
;;;
;;;     This expert system administers technological process 
;;;     of  creations of details of the complex form
;;;
;;;     CLIPS Version 6.0 Example
;;;
;;;     To execute, merely load, reset and run.
;;;======================================================
	(deffacts initial-state
	      (Ds 800)        
	      (Dm 2)     
	      (Da 2)  
              (Dar 1))    
	
	(defrule  rule1
	 (declare (salience 9098))
	  (Ds 10)         
	  (Dm 1)     
	  (Da 1)         
	=>
	 (printout t  "Rule1: Vr=A, Vm=10, T=0, I=1, G=tor "  crlf))
	

	(defrule  rule2
	 (declare (salience 9095))
	  (Ds 10)         
	  (Dm 2)     
	  (Da 2)         
	=>
	 (printout t  "Rule2: Vr=B, Vm=10, T=1, I=1, G=line, Rm=40, J=80, S=60 "  crlf))	

	(defrule  rule3
	 (declare (salience 9092))
	  (Ds 300)         
	  (Dm 2)        
	=>
	 (printout t  "Rule3: Vr=B, Vm=20, T=2, I=1, G=tor "  crlf))

	(defrule  rule4
	 (declare (salience 9097))
	  (Ds 300)            
	  (Da 3)         
	=>
	 (printout t  "Rule4: Vr=C, Vm=40, T=3, I=2, G= line, Rm=50, J=75, S=75"  crlf))

	(defrule  rule5
	 (declare (salience 9094))
	  (Ds 800)         
	  (Dm 2)     
	  (Da 2)         
	  (Dar 1)   
	=>
	 (printout t  "Rule5: Vr=B, Vm=60, T=4, I=2, G= line, Rm=60, J=70, S=70 "  crlf))

	(defrule  rule6_7
	 (declare (salience 9090))
	  (Ds 800)             
	  (Dar ?num)  
	=>
	  (if (< ?num 3)  
	    then
	     (printout t "Rule6: Vr=B, Vm=40, T=6, I=3, G= line, Rm=60, J=60, S=75 "  crlf)
	    else
	     (printout t "Rule7: Vr=C, Vm=80, T=6, I=3, G= line, Rm=60, J=60, S=75 "  crlf))) 

Rule5: Vr=B, Vm=60, T=4, I=2, G= line, Rm=60, J=70, S=70

(defrule Dar_parameter
(declare (salience 9101))
	(Dar ? num)
=>
(printout t "Ds parameter has value "crlf"
 1) 10 "crlf" 2) 300 "crlf" 3) 800 "crlf" Choose 1—3 =>")
	(assert (Dar =(read))))

(deftemplate goal
	(slot move)
	(slot on-top-of))
(deffacts initial-state
	(stack A B C)
	(stack D E F)
	(goal (move C) (on-top-of E)))
(defrule move-directly
	?goal < — (goal (move ?block1) (on-top-of ?block2))
	?stack-1 < — (stack ?block1 $?rest1)
	?stack-2 < — (stack ?block2 $?rest2)
	=>
(retract ?goal ?stack-1 ?stack-2)
	(assert (stack $?rest1))
	(assert (stack ?block1 ?block2 $?rest2))
	(printout t ?block1 "moved on top of" ?block2 crlf))
(defrule move-to-floor >
?goal < — (goal (move ?block1) (on-top-of floor))
?stack-1 < — (stack ?block1 $?rest)
	=>
	(retract ?goal ?stack-1)
	(assert (stack ?block1))
	(assert (stack $?rest))
	(printout t ?block1 "moved to the floor." crlf))
(defrule clear-upper-block
	(goal (move ?block))
	(stack ?top $? ?block $?)
	=>
	(assert (goal (move ?top) (on-top-of floor))))
(defrule clear-lower-block
	(goal (on-top-of ?block))
	(stack ?top $? ?block $?)
	=>
	(assert (goal (move ?top) (on-top-of floor))))

CLIPS$>$ (run)
A moved to the floor.
B moved to the floor.
D moved to the floor.
C moved on top of E
CLIPS$>$