The problem is to fill a multifield slot from single slots. To specify the idea, there a set of facts of the same template where some single slots are allready filled, and another template where a multifield slots are not yet filled. It is need to fill the latter with values of single slots values from single slots facts belonging to another template.
For Instance, here the templates declared:
(deftemplate Connexion
(slot ID-BUS)
(multislot CB-CLOSED (default nil))
(multislot CB-OPEN (default nil)))
(deftemplate CB
(slot ID-BUS)
(slot NUM-CB)
(slot STATE-CB (allowed-integers -1 0 1)(default -1)))
(deftemplate State-Vector
(multislot CB-CLOSED (default nil))
(multislot CB-OPEN (default nil)))
Suppose a following facts:
(deffacts Some-Facts
(State-Vector (CB-CLOSED 1 4 5 6 7)(CB-OPEN 2 3 8 9))
(CB (ID-BUS B1)(NUM-CB 1)(STATE-CB 1))
(CB (ID-BUS B1)(NUM-CB 4)(STATE-CB 1))
(CB (ID-BUS B1)(NUM-CB 6)(STATE-CB 1))
(CB (ID-BUS B2)(NUM-CB 2)(STATE-CB 0))
(CB (ID-BUS B2)(NUM-CB 5)(STATE-CB 1))
(CB (ID-BUS B2)(NUM-CB 8)(STATE-CB 0))
(CB (ID-BUS B3)(NUM-CB 3)(STATE-CB 0))
(CB (ID-BUS B3)(NUM-CB 7)(STATE-CB 1))
(CB (ID-BUS B3)(NUM-CB 9)(STATE-CB 0))
(Connexion (ID-BUS B1)(CB-CLOSED nil)(CB-OPEN nil))
(Connexion (ID-BUS B2)(CB-CLOSED nil)(CB-OPEN nil))
(Connexion (ID-BUS B3)(CB-CLOSED nil)(CB-OPEN nil)))
What was required is to fill multifield slots CB-CLOSED and CB-OPEN belonging to template Connexion from facts belonging to template CB. The expected results will be something like this:
(Connexion (ID-BUS B1)(CB-CLOSED 1 4 6)(CB-OPEN nil))
(Connexion (ID-BUS B2)(CB-CLOSED 5)(CB-OPEN 2 8)))
(Connexion (ID-BUS B3)(CB-CLOSED 7)(CB-OPEN 3 9)))
Question: How did I proceed to obtain this results ?
CLIPS>
(deftemplate Connexion
(slot ID-BUS)
(multislot CB-CLOSED (default nil))
(multislot CB-OPEN (default nil)))
CLIPS>
(deftemplate CB
(slot ID-BUS)
(slot NUM-CB)
(slot STATE-CB (allowed-integers -1 0 1)(default -1)))
CLIPS>
(deftemplate State-Vector
(multislot CB-CLOSED (default nil))
(multislot CB-OPEN (default nil)))
CLIPS>
(deffacts Some-Facts
(State-Vector (CB-CLOSED 1 4 5 6 7)(CB-OPEN 2 3 8 9))
(CB (ID-BUS B1)(NUM-CB 1)(STATE-CB 1))
(CB (ID-BUS B1)(NUM-CB 4)(STATE-CB 1))
(CB (ID-BUS B1)(NUM-CB 6)(STATE-CB 1))
(CB (ID-BUS B2)(NUM-CB 2)(STATE-CB 0))
(CB (ID-BUS B2)(NUM-CB 5)(STATE-CB 1))
(CB (ID-BUS B2)(NUM-CB 8)(STATE-CB 0))
(CB (ID-BUS B3)(NUM-CB 3)(STATE-CB 0))
(CB (ID-BUS B3)(NUM-CB 7)(STATE-CB 1))
(CB (ID-BUS B3)(NUM-CB 9)(STATE-CB 0))
(Connexion (ID-BUS B1)(CB-CLOSED nil)(CB-OPEN nil))
(Connexion (ID-BUS B2)(CB-CLOSED nil)(CB-OPEN nil))
(Connexion (ID-BUS B3)(CB-CLOSED nil)(CB-OPEN nil)))
CLIPS>
(defrule populate-connexion
?c <- (Connexion (ID-BUS ?name) (CB-CLOSED nil) (CB-OPEN nil))
=>
(bind ?closed (create$))
(bind ?open (create$))
(do-for-all-facts ((?cb CB)) (eq ?cb:ID-BUS ?name)
(if (eq ?cb:STATE-CB 1)
then
(bind ?closed (create$ ?closed ?cb:NUM-CB))
else
(bind ?open (create$ ?open ?cb:NUM-CB))))
(modify ?c (CB-CLOSED ?closed) (CB-OPEN ?open)))
CLIPS> (reset)
CLIPS> (run)
CLIPS> (facts)
f-0 (initial-fact)
f-1 (State-Vector (CB-CLOSED 1 4 5 6 7) (CB-OPEN 2 3 8 9))
f-2 (CB (ID-BUS B1) (NUM-CB 1) (STATE-CB 1))
f-3 (CB (ID-BUS B1) (NUM-CB 4) (STATE-CB 1))
f-4 (CB (ID-BUS B1) (NUM-CB 6) (STATE-CB 1))
f-5 (CB (ID-BUS B2) (NUM-CB 2) (STATE-CB 0))
f-6 (CB (ID-BUS B2) (NUM-CB 5) (STATE-CB 1))
f-7 (CB (ID-BUS B2) (NUM-CB 8) (STATE-CB 0))
f-8 (CB (ID-BUS B3) (NUM-CB 3) (STATE-CB 0))
f-9 (CB (ID-BUS B3) (NUM-CB 7) (STATE-CB 1))
f-10 (CB (ID-BUS B3) (NUM-CB 9) (STATE-CB 0))
f-14 (Connexion (ID-BUS B3) (CB-CLOSED 7) (CB-OPEN 3 9))
f-15 (Connexion (ID-BUS B2) (CB-CLOSED 5) (CB-OPEN 2 8))
f-16 (Connexion (ID-BUS B1) (CB-CLOSED 1 4 6) (CB-OPEN))
For a total of 14 facts.
CLIPS>
Alternately, you can populate the Connexion facts in a single rule firing:
(defrule populate-connexion
=>
(do-for-all-facts ((?cn Connexion))
(and (eq ?cn:CB-CLOSED (create$ nil)) (eq ?cn:CB-OPEN (create$ nil)))
(bind ?closed (create$))
(bind ?open (create$))
(do-for-all-facts ((?cb CB)) (eq ?cb:ID-BUS ?cn:ID-BUS)
(if (eq ?cb:STATE-CB 1)
then
(bind ?closed (create$ ?closed ?cb:NUM-CB))
else
(bind ?open (create$ ?open ?cb:NUM-CB))))
(modify ?cn (CB-CLOSED ?closed) (CB-OPEN ?open)))))
Related
Can someone explain me how can I import the WEKA created rules in CLIPS and evaluate its efficience in TRS and TES data?
The data I use
I have written 7 rules out of 20 from WEKA tree. I include also 3 instances from the glass datasheet
small test code
(deftemplate glass
(slot n(type FLOAT))
(slot m(type FLOAT))
(slot a(type FLOAT))
(slot b(type FLOAT))
(slot r(type FLOAT))
(slot s(type FLOAT))
(slot k(type FLOAT))
(slot c(type FLOAT)))
(deftemplate Type
(slot type))
(deffacts instances1
(glass (n 13.00)
(m 2.28)
(a 1.00)
(b 0.00)))
(deffacts instances2
(glass (n 13.70)
(m 1.80)
(a 1.40)
(b 0.00)))
(deffacts instances3
(glass (n 13.70)
(m 1.90)
(a 1.40)
(b 0.00)))
(defrule R1
(glass (b ?b))
(test (<= ?b 0.27))
(glass (m ?m))
(test (<= ?m 2.41))
(glass (n ?n))
(test (<= ?n 13.78))
(glass (a ?a))
(test (<= ?a 1.38))
=>
(assert (Type (type buildwindnonfloat1)))
(printout t "buildwindnonfloat1 detected" crlf))
(defrule R2
(glass (b ?b))
(test (<= ?b 0.27))
(glass (m ?m))
(test (<= ?m 2.41))
(glass (n ?n))
(test (<= ?n 13.78))
(glass (a ?a))
(test (> ?a 1.38))
(glass (m ?m))
(test (<= ?m 1.88))
=>
(assert (Type (type containers2)))
(printout t "containers2 detected" crlf))
(defrule R3
(glass (b ?b))
(test (<= ?b 0.27))
(glass (m ?m))
(test (<= ?m 2.41))
(glass (n ?n))
(test (<= ?n 13.78))
(glass (a ?a))
(test (> ?a 1.38))
(glass (m ?m))
(test (> ?m 1.88))
=>
(assert (Type (type buildwindnonfloat3)))
(printout t "buildwindnonfloat3 detected" crlf))
(defrule R4
(glass (b ?b))
(test (<= ?b 0.27))
(glass (m ?m))
(test (<= ?m 2.41))
(glass (n ?n))
(test (> ?n 13.78))
=>
(assert (Type (type tableware4)))
(printout t "tableware detected" crlf))
(defrule R5
(glass (b ?b))
(test (<= ?b 0.27))
(glass (m ?m))
(test (> ?m 2.41))
(glass (a ?a))
(test (<= ?a 1.4))
(glass (m ?m))
(test (<= ?m 3.34))
(glass (a ?a))
(test (<= ?a 1.25))
=>
(assert (Type (type buildwindnonfloat5)))
(printout t "buildwindnonfloat5 detected" crlf))
(defrule R6
(glass (b ?b))
(test (<= ?b 0.27))
(glass (m ?m))
(test (> ?m 2.41))
(glass (a ?a))
(test (<= ?a 1.4))
(glass (m ?m))
(test (<= ?m 3.34))
(glass (a ?a))
(test (> ?a 1.25))
=>
(assert (Type (type buildwindfloat6)))
(printout t "buildwindfloat6 detected" crlf))
(defrule R7
(glass (b ?b))
(test (<= ?b 0.27))
(glass (m ?m))
(test (> ?m 2.41))
(glass (a ?a))
(test (<= ?a 1.4))
(glass (m ?m))
(test (> ?m 3.34))
(glass (m ?m))
(test (<= ?m 3.82))
(glass (r ?r))
(test (<= ?r 1.51707))
(glass (r ?r))
(test (<= ?r 51596))
=>
(assert (Type (type buildwindfloat7)))
(printout t "buildwindfloat7 detected" crlf))
To convert your data, it's easiest to read the data from the file when your program is running and directly assert the facts. So if your data looks like the following with each entry on its own line
1.5159,13.24,3.34,1.47,73.1,0.39,8.22,0,0,'build wind non-float'
1.5167,13.24,3.57,1.38,72.7,0.56,8.44,0,0.1,'vehic wind float'
then your can read your data by reading each line as a single string, replacing the commas with spaces, and then splitting the string into multiple values. You can then have a separate rule map the values from your file to the appropriate slots in your deftemplate facts.
Store the expected result with each glass fact and then you can compare that value to the value that your rule is proposing.
CLIPS (6.31 6/12/19)
CLIPS>
(deftemplate glass
(slot n (type FLOAT))
(slot m (type FLOAT))
(slot a (type FLOAT))
(slot b (type FLOAT))
(slot r (type FLOAT))
(slot s (type FLOAT))
(slot k (type FLOAT))
(slot c (type FLOAT))
(slot f (type FLOAT))
(slot type))
CLIPS>
(deftemplate input
(multislot data))
CLIPS>
(deffunction str-rpl (?str ?find ?replace)
(if (eq ?find "")
then
(return ?str))
(bind ?rs "")
(bind ?fl (str-length ?find))
(bind ?i (str-index ?find ?str))
(while (neq ?i FALSE)
(bind ?rs (str-cat ?rs (sub-string 1 (- ?i 1) ?str) ?replace))
(bind ?str (sub-string (+ ?i ?fl) (str-length ?str) ?str))
(bind ?i (str-index ?find ?str)))
(bind ?rs (str-cat ?rs ?str))
?rs)
CLIPS>
(defrule get-data
=>
(printout t "Input File? ")
(bind ?file (readline))
(if (not (open ?file data))
then
(printout t "Unable to open file" crlf)
(return))
(bind ?line (readline data))
(while (neq ?line EOF)
(bind ?line (str-rpl ?line "," " "))
(bind ?line (str-rpl ?line "'" "\""))
(assert (input (data (explode$ ?line))))
(bind ?line (readline data)))
(close data))
CLIPS>
(defrule convert-data
?i <- (input (data ?r ?n ?m ?a ?s ?k ?c ?b ?f ?type))
=>
(retract ?i)
(assert (glass (r ?r) (n ?n) (m ?m) (a ?a) (s ?s) (k ?k) (c ?c) (b ?b) (f ?f) (type ?type))))
CLIPS>
(defrule R1
(glass (b ?b)
(m ?m)
(n ?n)
(a ?a)
(type ?type))
(test (<= ?b 0.27))
(test (<= ?m 2.41))
(test (<= ?n 13.78))
(test (<= ?a 1.38))
=>
(printout t "buildwindnonfloat1 detected type = " ?type crlf))
CLIPS>
(defrule R2
(glass (b ?b)
(m ?m)
(n ?n)
(a ?a)
(type ?type))
(test (<= ?b 0.27))
(test (<= ?m 2.41))
(test (<= ?n 13.78))
(test (> ?a 1.38))
(test (<= ?m 1.88))
=>
(printout t "containers2 detected type = " ?type crlf))
CLIPS>
(defrule R3
(glass (b ?b)
(m ?m)
(n ?n)
(a ?a)
(type ?type))
(test (<= ?b 0.27))
(test (<= ?m 2.41))
(test (<= ?n 13.78))
(test (> ?a 1.38))
(test (> ?m 1.88))
=>
(printout t "buildwindnonfloat3 detected type = " ?type crlf))
CLIPS>
(defrule R4
(glass (b ?b)
(m ?m)
(n ?n)
(type ?type))
(test (<= ?b 0.27))
(test (<= ?m 2.41))
(test (> ?n 13.78))
=>
(printout t "tableware detected type = " ?type crlf))
CLIPS>
(defrule R5
(glass (b ?b)
(m ?m)
(a ?a)
(type ?type))
(test (<= ?b 0.27))
(test (> ?m 2.41))
(test (<= ?a 1.4))
(test (<= ?m 3.34))
(test (<= ?a 1.25))
=>
(printout t "buildwindnonfloat5 detected type = " ?type crlf))
CLIPS>
(defrule R6
(glass (b ?b)
(m ?m)
(a ?a)
(type ?type))
(test (<= ?b 0.27))
(test (> ?m 2.41))
(test (<= ?a 1.4))
(test (<= ?m 3.34))
(test (> ?a 1.25))
=>
(printout t "buildwindfloat6 detected type = " ?type crlf))
CLIPS>
(defrule R7
(glass (b ?b)
(m ?m)
(a ?a)
(r ?r)
(type ?type))
(test (<= ?b 0.27))
(test (> ?m 2.41))
(test (<= ?a 1.4))
(test (> ?m 3.34))
(test (<= ?m 3.82))
(test (<= ?r 1.51707))
(test (<= ?r 51596))
=>
(printout t "buildwindfloat7 detected type = " ?type crlf))
CLIPS> (reset)
CLIPS> (run)
Input File? weka.txt
buildwindfloat7 detected type = vehic wind float
CLIPS>
I want to build an expert system in which in a case of emergency at a building with some floors (it needs to work for any amount of floors) the elevator should take the people into the ground.
The thing is, that the defrule to send the elevator at any floor never makes it in the agenda, so the system just does nothing. The correct action should be to fire the rule and then another rule that takes the people from the floor.
The code for the defrule is this:
(defrule move_to_floor "elevator moves to any floor "
?i <- (elevator is_at floor ?x has ?y adults and ?z minors)
(floor ?fl&~?x has ?n adult and ?m minor people)
(test (> (+ ?n ?m) 0))
=>
(retract ?i)
(assert (elevator is_at floor ?fl has ?y adults and ?z minors))
)
The facts as they have been initialized from the user in another defrule above are these:
f-0 (initial-fact)
f-1 (elevator is_at 0 has 0 adults and 0 minors)
f-3 (capacity 4)
f-4 (floors 3)
f-5 (initCanEnter 0) ;At 0 this prevents from entering the init_defrule again
f-6 (floor 3 has 2 adult and 1 minor people)
f-7 (floor 2 has 4 adult and 5 minor people)
f-8 (floor 1 has 1 adult and 2 minor people)
I can't seem to find the solution. Also, I'm using deffacts and not deftemplate as I have seen many people using on the internet.
You can use the matches command to see which patterns in a rule are matched.
CLIPS (6.31 2/3/18)
CLIPS>
(defrule move_to_floor "elevator moves to any floor "
?i <- (elevator is_at floor ?x has ?y adults and ?z minors)
(floor ?fl&~?x has ?n adult and ?m minor people)
(test (> (+ ?n ?m) 0))
=>
(retract ?i)
(assert (elevator is_at floor ?fl has ?y adults and ?z minors)))
CLIPS>
(deffacts initial
(elevator is_at 0 has 0 adults and 0 minors)
(capacity 4)
(floors 3)
(initCanEnter 0) ;At 0 this prevents from entering the init_defrule again
(floor 3 has 2 adult and 1 minor people)
(floor 2 has 4 adult and 5 minor people)
(floor 1 has 1 adult and 2 minor people))
CLIPS> (reset)
CLIPS> (matches move_to_floor)
Matches for Pattern 1
None
Matches for Pattern 2
f-5
f-6
f-7
Partial matches for CEs 1 - 2
None
Activations
None
(3 0 0)
CLIPS>
In this case, the first pattern is not matched. That's because your pattern expects is_at floor ?x but your fact contains is_at 0 (the symbol floor is missing in your fact). If you correct this issue, the rule will be placed on the agenda.
CLIPS>
(deffacts initial
(elevator is_at floor 0 has 0 adults and 0 minors)
(capacity 4)
(floors 3)
(initCanEnter 0) ;At 0 this prevents from entering the init_defrule again
(floor 3 has 2 adult and 1 minor people)
(floor 2 has 4 adult and 5 minor people)
(floor 1 has 1 adult and 2 minor people))
CLIPS> (reset)
CLIPS> (agenda)
0 move_to_floor: f-1,f-7
0 move_to_floor: f-1,f-6
0 move_to_floor: f-1,f-5
For a total of 3 activations.
CLIPS>
If you issue a (run) command at this point, the rules will endlessly fire in a loop moving from floor to floor, so that's something you'll need to address next.
If you use deftemplate facts rather than ordered facts, you'll get an error if you misspell slot names, so it's better to use these if you have a fact with multiple attributes.
CLIPS> (clear)
CLIPS>
(deftemplate elevator
(slot at_floor (type INTEGER))
(slot adults (type INTEGER))
(slot minors (type INTEGER)))
CLIPS>
(deftemplate floor
(slot # (type INTEGER))
(slot adults (type INTEGER))
(slot minors (type INTEGER)))
CLIPS>
(deffacts initial
(elevator (at_floor 0))
(capacity 4)
(floors 3)
(initCanEnter 0)
(floor (# 3) (adults 2) (minors 1))
(floor (# 2) (adults 4) (minors 5))
(floor (# 1) (adults 1) (minors 2)))
CLIPS>
(defrule move_to_floor
?i <- (elevator (at_floor ?x))
(floor (# ?fl&~?x) (adults ?n) (minors ?m))
(test (> (+ ?n ?m) 0))
=>
(modify ?i (at_floor ?fl)))
CLIPS> (reset)
CLIPS> (facts)
f-0 (initial-fact)
f-1 (elevator (at_floor 0) (adults 0) (minors 0))
f-2 (capacity 4)
f-3 (floors 3)
f-4 (initCanEnter 0)
f-5 (floor (# 3) (adults 2) (minors 1))
f-6 (floor (# 2) (adults 4) (minors 5))
f-7 (floor (# 1) (adults 1) (minors 2))
For a total of 8 facts.
CLIPS> (agenda)
0 move_to_floor: f-1,f-7
0 move_to_floor: f-1,f-6
0 move_to_floor: f-1,f-5
For a total of 3 activations.
CLIPS>
I'm trying to build a simple expert system for recommending courses and want to implement certainty factor in my program, however I'm stuck looking for a simple integration method.
I've stumbled upon this example but can't seems to figure out how to make it fire.
; Allow facts that are duplicates:
(defrule start
(declare (salience 1000))
(initial-fact)
=>
(set-fact-duplication TRUE))
(defrule combine-certainities-both-positive
?fact1 <- (organism ?attribute ?value ?C1&:(>= ?C1 0))
?fact2 <- (organism ?attribute ?value ?C2&:(>= ?C2 0))
(test (neq ?fact1 ?fact2))
=>
(retract ?fact1 ?fact2)
(bind ?C3 (- (+ ?C1 ?C2) (* ?C1 ?C2)))
(assert (organism ?attribute ?value ?C3)))
(defrule combine-certainities-both-negative
?fact1 <- (organism ?attribute ?value ?C1&:(< ?C1 0))
?fact2 <- (organism ?attribute ?value ?C2&:(< ?C2 0))
(test (neq ?fact1 ?fact2))
=>
(retract ?fact1 ?fact2)
(bind ?C3 (+ (+ ?C1 ?C2) (* ?C1 ?C2)))
(assert (organism ?attribute ?value ?C3)))
(defrule combine-certainities-with-opposite-signs
?fact1 <- (organism ?attribute ?value ?C1)
?fact2 <- (organism ?attribute ?value ?C2)
(test (< (* ?C1 ?C2) 0))
(test (neq ?fact1 ?fact2))
=>
(retract ?fact1 ?fact2)
(bind ?C3 (/ (+ ?C1 ?C2) (- 1 (min (abs ?C1) (abs ?C2)))))
(assert (organism ?attribute ?value ?C3)))
I try to assert two new organism facts to kick start the first rule:
CLIPS> (assert (organism morpholgy1 rod1 0.25)
(organism morpholgy2 rod2 0.25))
==> f-4 (organism morpholgy1 rod1 0.25)
==> f-5 (organism morpholgy2 rod2 0.25)
<Fact-5>
CLIPS> (run)
<== Focus MAIN
0 rules fired Run time is 0.00300693511962891 seconds.
0.0 rules per second.
2 mean number of facts (2 maximum).
0 mean number of instances (0 maximum).
0 mean number of activations (0 maximum).
And use the matches but still don't get how to make it match here..
CLIPS> (matches combine-certainities-both-positive)
Matches for Pattern 1
f-4
f-5
Matches for Pattern 2
f-4
f-5
Partial matches for CEs 1 - 2
None
Activations
None
(4 0 0)
The attribute and the value have to match (morpholgy1 != morpholgy2 and rod1 != rod2). That's why fact duplication has to be enabled to allow multiple copies of the same attribute/value.
CLIPS> (set-fact-duplication TRUE)
FALSE
CLIPS>
(assert (organism morpholgy rod 0.25)
(organism morpholgy rod 0.25))
<Fact-2>
CLIPS> (watch facts)
CLIPS> (run)
<== f-2 (organism morpholgy rod 0.25)
<== f-1 (organism morpholgy rod 0.25)
==> f-3 (organism morpholgy rod 0.4375)
CLIPS>
How to make fact in multiple type? like in this code get the same rank fact together.
(P X Y) means X is Y's elder member
i had tried this:
(deffacts people
(P a b)
(P b c)
(P a d)
(P d e)
(P d f)
)
(defrule ranking
(P ?x ?y)
(P ?y ?z)
=>
(assert (R ?x $?y $?z))
)
i want to make a complete seniority in the family,
and get (R a bd cef), but i just get (R a b c) (R a d e) (R a d f)
can u help me?
It's a bit more complicated than what you've attempted, particularly if you want it to work properly for more than 3 generations and/or multiple family groups.
CLIPS>
(defmethod concat$ ((?m1 MULTIFIELD) (?m2 MULTIFIELD (>= (length$ ?m1) (length$ ?m2))))
(bind ?rv (create$))
(loop-for-count (?i 1 (length$ ?m2))
(bind ?rv (create$ ?rv (sym-cat (nth$ ?i ?m1) (nth$ ?i ?m2)))))
(create$ ?rv (mv-subseq (+ 1 (length$ ?m2)) (length$ ?m1) ?m1)))
CLIPS>
(defmethod concat$ ((?m1 MULTIFIELD) (?m2 MULTIFIELD (< (length$ ?m1) (length$ ?m2))))
(bind ?rv (create$))
(loop-for-count (?i 1 (length$ ?m1))
(bind ?rv (create$ ?rv (sym-cat (nth$ ?i ?m1) (nth$ ?i ?m2)))))
(create$ ?rv (mv-subseq (+ 1 (length$ ?m1)) (length$ ?m2) ?m2)))
CLIPS>
(deffacts people
(P a b) ; Family 1
(P b c)
(P a d)
(P d e)
(P d f)
(P g h) ; Family 2
(P h j)
(P h k)
(P k l)
(P k m)
(P k n)
(P j o)
(P j p)
(P j q)
(P q r)
(P q s))
CLIPS>
(defrule copy
(P ?x ?y)
=>
(assert (R ?x ?y)))
CLIPS>
(defrule extend
?f1 <- (R $?b ?x ?ym $?e1)
?f2 <- (R ?y $?z)
(test (str-index ?y ?ym))
=>
(retract ?f1 ?f2)
(assert (R ?b ?x ?ym (concat$ ?e1 ?z))))
CLIPS>
(defrule combine
?f1 <- (R ?x $?b ?y1 $?e1)
?f2 <- (R ?x $?b ?y2&~?y1 $?e2)
=>
(retract ?f1 ?f2)
(assert (R ?x ?b (sym-cat ?y1 ?y2) (concat$ ?e1 ?e2))))
CLIPS> (reset)
CLIPS> (run)
CLIPS> (facts)
f-0 (initial-fact)
f-1 (P a b)
f-2 (P b c)
f-3 (P a d)
f-4 (P d e)
f-5 (P d f)
f-6 (P g h)
f-7 (P h j)
f-8 (P h k)
f-9 (P k l)
f-10 (P k m)
f-11 (P k n)
f-12 (P j o)
f-13 (P j p)
f-14 (P j q)
f-15 (P q r)
f-16 (P q s)
f-37 (R g h jk opqlmn rs)
f-46 (R a bd cef)
For a total of 19 facts.
CLIPS>
I'm trying to change the design of an expert system to work carried out by my rules.
Topic - processing of different parts on different machines. Naturally, each kind of items processed at different times on different machines.
The system consists of three rules. The first rule - load machines work. The second rule - unloads machines. The third rule - performs the movement of time.
I added in the first rule of a function call, which seeks item with maximum processing time. However, the expert system stopped working. Simply displays "1". That's all.
(defglobal ?*time* = 0)
(deftemplate details
(field det (type SYMBOL))
(field oper (type INTEGER))
(field count (type INTEGER))
)
(deftemplate route
(field det (type SYMBOL))
(field oper (type INTEGER))
(field machine (type INTEGER))
(field time (type INTEGER))
)
(deftemplate machine
(field num (type INTEGER))
(field count (type INTEGER)(default 0))
(field det (type SYMBOL)(default A))
(field oper (type INTEGER)(default 0))
(field time (type INTEGER)(default 0))
)
(deffacts details
(details (det A) (oper 0) (count 100))
(details (det B) (oper 0) (count 150))
(details (det C) (oper 0) (count 200))
(details (det D) (oper 0) (count 300))
(details (det E) (oper 0) (count 200))
(details (det A) (oper 1) (count 0))
(details (det B) (oper 1) (count 0))
(details (det C) (oper 1) (count 0))
(details (det D) (oper 1) (count 0))
(details (det E) (oper 1) (count 0))
....
)
(deffacts route
(route (det A) (oper 1) (machine 1) (time 10))
(route (det A) (oper 2) (machine 2) (time 5))
(route (det A) (oper 2) (machine 2) (time 2))
(route (det A) (oper 3) (machine 3) (time 4))
(route (det A) (oper 3) (machine 4) (time 3))
(route (det A) (oper 4) (machine 4) (time 8))
(route (det A) (oper 4) (machine 1) (time 8))
(route (det B) (oper 1) (machine 1) (time 8))
(route (det B) (oper 2) (machine 5) (time 4))
(route (det B) (oper 2) (machine 2) (time 6))
(route (det B) (oper 3) (machine 6) (time 3))
(route (det B) (oper 3) (machine 5) (time 2))
(route (det B) (oper 4) (machine 7) (time 2))
(route (det B) (oper 4) (machine 2) (time 3))
...
)
(deffacts machines
(machine (num 1))
(machine (num 2))
(machine (num 3))
(machine (num 4))
(machine (num 5))
(machine (num 6))
(machine (num 7))
(machine (num 8))
)
(deffunction my-predicate (?fact1 ?fact2)
(< (fact-slot-value ?fact1 time) (fact-slot-value ?fact2 time)))
(deffunction find-max2 (?template1 ?predicate1 ?operation ?template2 ?max)
(bind ?max FALSE)
(do-for-all-facts ((?f2 ?template2)) (eq (fact-slot-value ?f2 count) 0)
(do-for-all-facts ((?f1 ?template1)) (eq (fact-slot-value ?f1 oper) ?operation) (eq (fact-slot-value ?f1 oper)(fact-slot-value ?f2 oper))
(if (or (not ?max) (funcall ?predicate1 ?f1 ?max))
then
(bind ?max ?f1)))
)
)
;--------------------------------------------------------------------------------------------------
(defrule work_on_1
(declare (salience 10000))
(machine (num ?num1)(count ?count1) (time ?time1))
(test (eq ?count1 0))
(test (eq ?time1 0))
?node1 <- (machine (num ?num1)(count ?count1) (time ?time1))
(details (det ?detail) (oper ?operation1) (count ?count2))
(test (not (eq ?count2 0)))
?node2 <- (details (det ?detail) (oper ?operation1) (count ?count2))
; add this code
(funcall find-max2 route my-predicate ?operation1 details ?max)
(test (eq ?operation1(fact-slot-value ?max oper )))
(route (machine ?num1) (det ?detail) (oper ?operation2) (time ?time2))
(test (eq ?operation2 (+ ?operation1 1)))
=>
(if (> ?count2 30)
then
(modify ?node1 (count 30) (time ?time2) (oper ?operation2) (det ?detail))
(modify ?node2 (count (- ?count2 30)))
(printout t ?*time*" ," ?num1 " 30 деталей типа "?detail " , " ?operation2 " , " ?time2 crlf)
else
(modify ?node1 (count ?count2) (time ?time2) (oper ?operation2) (det ?detail))
(modify ?node2 (count (- ?count2 ?count2)))
(printout t ?*time*" , " ?num1 " " ?count2 " , "?detail " , " ?operation2 " , " ?time2 crlf)
)
)
There are numerous issues with the code. First it's unclear why there’s redundant pattern matching for the machine and details facts:
(machine (num ?num1)(count ?count1) (time ?time1))
(test (eq ?count1 0))
(test (eq ?time1 0))
?node1 <- (machine (num ?num1)(count ?count1) (time ?time1))
(details (det ?detail) (oper ?operation1) (count ?count2))
(test (not (eq ?count2 0)))
?node2 <- (details (det ?detail) (oper ?operation1) (count ?count2))
The following code is sufficient to achieve the same task:
?node1 <- (machine (num ?num1) (count ?count1&0) (time ?time1&0))
?node2 <- (details (det ?detail) (oper ?operation1) (count ?count2&~0))
Second, it looks like you're expecting the funcall pattern to invoke a function call and place the result of that function call in the variable ?max:
(funcall find-max2 route my-predicate ?operation1 details ?max)
There is no funcall conditional element that has this type of behavior. In this case, you've just created a pattern conditional element that's looking for an ordered fact with the relation name funcall. If you wanted to invoke funcall from the conditions of a rule you'd use the test conditional element:
(test (funcall find-max2 route my-predicate ?operation1 details))
Since the function being invoked is a literal, find-max2, there's really no point in using funcall since you can just call the function directly:
(test (find-max2 route my-predicate ?operation1 details))
Third, there's not much point to using the query functions within the conditions of a rule since you can directly pattern match on the facts instead. In addition, the placement of the query function you've used within the conditions will cause it to be executed once there are matching machine/details facts, but possibly before there are any route facts, so it will likely not even return the correct results.
The following rule shows how to find the maximum values without using query functions:
(defrule find-max
(route (oper ?oper1) (time ?time1))
(exists (details (count 0) (oper ?oper1)))
(not (and (route (oper ?oper2) (time ?time2&:(> ?time2 ?time1)))
(exists (details (count 0) (oper ?oper2)))))
=>
(printout t "Maximum time is " ?time1 crlf))
(defrule work_on_1
(declare (salience 10000))
?node1 <- (machinegun (num ?num1) (count ?count1&0) (time ?time1&0))
?node2 <- (store (det ?detail) (oper ?operation1) (count ?count2&~0))
(tex_route (oper ?oper1) (time ?time2))
(exists (store (count 0) (oper ?oper1)))
(not (and (tex_route (oper ?oper2) (time ?time3&:(> ?time3 ?time2)))
(exists (store (count 0) (oper ?oper2)))))
(test (eq ?time1 ?time2))
(route (machine ?num1) (det ?detail) (oper ?operation2) (time ?time2))
(test (eq ?operation2 (+ ?operation1 1)))
=>
(if (> ?count2 30)
then
(modify ?node1 (count 30) (time ?time2) (oper ?operation2) (det ?detail))
(modify ?node2 (count (- ?count2 30)))
(printout t ?*time*" ," ?num1 " 30 деталей типа "?detail " , " ?operation2 " , " ?time2 crlf)
else
(modify ?node1 (count ?count2) (time ?time2) (oper ?operation2) (det ?detail))
(modify ?node2 (count (- ?count2 ?count2)))
(printout t ?*time*" , " ?num1 " " ?count2 " , "?detail " , " ?operation2 " , " ?time2 crlf)
)
)
It is new rule, but when the expert system stopped working - simply displays "1".