At first I solved a problem where I'd have an infinite loop, I fixed that by adding a rule to my CONSTRAIN module.
I've taken all constrains into consideration, but it seems like all the facts are being deleted for some reason...
This my code so far:
;;MAIN Module
(deftemplate state
(slot farmer-position)
(slot fox-position)
(slot goat-position)
(slot cabbage-position)
(slot id)
(slot prev-state (default nil))
(multislot move (default nil)))
(deftemplate finished
(slot value))
(deffacts initial-facts
(state (farmer-position s1)
(fox-position s1)
(goat-position s1)
(cabbage-position s1)
(id 0))
(opp s1 s2)
(opp s2 s1))
;;CONSTARIN Modle
(defmodule CONSTRAIN)
(defrule CONSTRAIN::fox-goat
(declare (auto-focus true))
?p<-(MAIN::state (fox-position ?f) (goat-position ?f) (farmer-position
~?f))
=>
(retract ?p))
(defrule CONSTRAIN::goat-cabbge
(declare (auto-focus true))
?p<-(MAIN::state (goat-position ?f) (cabbage-position ?f) (farmer-
position ~?f))
=>
(retract ?p))
(defrule CONSTRAIN::no-doubles
(declare (auto-focus true))
?p1<-(MAIN::state (farmer-position ?s1) (fox-position ?s2) (goat-
position ?s3) (cabbage-position ?s4) (id ?id1))
?p2<-(MAIN::state (farmer-position ?s1) (fox-position ?s2) (goat-
position ?s3) (cabbage-position ?s4) (id ?id2&:(> ?id2 ?id1)))
=>
(retract ?p2))
(defrule CONSTRAIN::stop-exc
(declare (auto-focus true))
?p1<-(MAIN::state (farmer-position s2) (fox-position s2) (goat-position
s2) (cabbage-position s2))
=>
(assert (MAIN::finished (value yes))))
;;MOVE Module
(defmodule MOVE)
(defrule MOVE::move-fox
?p<-(MAIN::state (farmer-position ?old) (fox-position ?old) (id ?id))
(not (MAIN::finished (value yes)))
(opp ?old ?new)
=>
(duplicate ?p (farmer-position ?new)
(fox-position ?new)
(prev-state ?p)
(id (+ ?id 1))
(move fox ?new)))
(defrule MOVE::move-goat
?p<-(MAIN::state (farmer-position ?old) (goat-position ?old) (id ?id))
(not (MAIN::finished (value yes)))
(opp ?old ?new)
=>
(duplicate ?p (farmer-position ?new)
(goat-position ?new)
(prev-state ?p)
(id (+ ?id 1))
(move goat ?new)))
(defrule MOVE::move-cabbage
?p<-(MAIN::state (farmer-position ?old) (cabbage-position ?old) (id ?
id))
(not (MAIN::finished (value yes)))
(opp ?old ?new)
=>
(duplicate ?p (farmer-position ?new)
(cabbage-position ?new)
(prev-state ?p)
(id (+ ?id 1))
(move cabbage ?new)))
;;RUN
(reset)
(watch all)
(focus MOVE)
(run)
(facts)
And here is my output:
<== Focus MAIN
==> Focus MOVE
FIRE 1 MOVE::move-fox f-1,, f-2
==> f-4 (MAIN::state (farmer-position s2) (fox-position s2) (goat-position
s1) (cabbage-position s1) (id 1) (prev-state <Fact-1>) (move fox s2))
==> Activation: CONSTRAIN::goat-cabbge : f-4
==> Activation: MOVE::move-fox : f-4,, f-3
<== Focus MOVE
==> Focus CONSTRAIN
FIRE 2 CONSTRAIN::goat-cabbge f-4
<== f-4 (MAIN::state (farmer-position s2) (fox-position s2) (goat-position
s1) (cabbage-position s1) (id 1) (prev-state <Fact-1>) (move fox s2))
<== Activation: MOVE::move-fox : f-4,, f-3
<== Focus CONSTRAIN
==> Focus MOVE
FIRE 3 MOVE::move-cabbage f-1,, f-2
==> f-5 (MAIN::state (farmer-position s2) (fox-position s1) (goat-position
s1) (cabbage-position s2) (id 1) (prev-state <Fact-1>) (move cabbage s2))
==> Activation: CONSTRAIN::fox-goat : f-5
==> Activation: MOVE::move-cabbage : f-5,, f-3
<== Focus MOVE
==> Focus CONSTRAIN
FIRE 4 CONSTRAIN::fox-goat f-5
<== f-5 (MAIN::state (farmer-position s2) (fox-position s1) (goat-position
s1) (cabbage-position s2) (id 1) (prev-state <Fact-1>) (move cabbage s2))
<== Activation: MOVE::move-cabbage : f-5,, f-3
<== Focus CONSTRAIN
==> Focus MOVE
FIRE 5 MOVE::move-goat f-1,, f-2
==> f-6 (MAIN::state (farmer-position s2) (fox-position s1) (goat-position
s2) (cabbage-position s1) (id 1) (prev-state <Fact-1>) (move goat s2))
==> Activation: MOVE::move-goat : f-6,, f-3
FIRE 6 MOVE::move-goat f-6,, f-3
==> f-7 (MAIN::state (farmer-position s1) (fox-position s1) (goat-position
s1) (cabbage-position s1) (id 2) (prev-state <Fact-6>) (move goat s1))
==> Activation: CONSTRAIN::no-doubles : f-1, f-7
==> Activation: MOVE::move-fox : f-7,, f-2
==> Activation: MOVE::move-goat : f-7,, f-2
==> Activation: MOVE::move-cabbage : f-7,, f-2
<== Focus MOVE
==> Focus CONSTRAIN
FIRE 7 CONSTRAIN::no-doubles f-1, f-7
<== f-7 (MAIN::state (farmer-position s1) (fox-position s1) (goat-position
s1) (cabbage-position s1) (id 2) (prev-state <Fact-6>) (move goat s1))
<== Activation: MOVE::move-fox : f-7,, f-2
<== Activation: MOVE::move-goat : f-7,, f-2
<== Activation: MOVE::move-cabbage : f-7,, f-2
<== Focus CONSTRAIN
==> Focus MOVE
<== Focus MOVE
==> Focus MAIN
<== Focus MAIN
For a total of 0 facts in module MOVE.
Fact f-6 was not retracted. The only valid first move is for the farmer to cross the river with the goat and that's the move represented by f-6. You don't have a rule for moving the farmer across the river alone, so the only valid move for the farmer from f-6 is to move back across the river with the goat which takes you back to the initial position. Since the initial position represented by f-1 is the same as f-7, the rule no-doubles retracts f-7 and there are no remaining valid moves.
If you download Jess from http://www.jessrules.com/jess/download.shtml, code for the river crossing example is available in the examples directory in the file dilemma.clp.
Related
I have a situation like this:
(deftemplate trip
(multislot place-sequence)
(multislot days-distribution)
)
(deftemplate travel-banchmark
(slot name)
(slot value)
)
(trip (place-sequence milano roma venezia) (days-distribution 1 1 1))
(trip (place-sequence roma milano venezia) (days-distribution 1 1 1))
(travel-banchmark (name travel-duration) (value 5))
Now for every trip-fact I have to assert all the possible trip with different days-distribution (the sum of days-distribution needs to be the travel-duration (e.g., 5))
Example:
(trip (place-sequence milano roma venezia) (days-distribution 3 1 1))
(trip (place-sequence milano roma venezia) (days-distribution 1 3 1))
(trip (place-sequence milano roma venezia) (days-distribution 1 1 3))
(trip (place-sequence milano roma venezia) (days-distribution 2 2 1))
(trip (place-sequence milano roma venezia) (days-distribution 1 1 2))
...
Is it possible to do this using rules? I have some problem in understanding the best way to do this kind of things with a rule-based system
Edit:
This is my way to calculate the sum inside the multislot but I still have a problem figuring out how to calculate the different days-distrubtion
(defrule test
(travel-banchmark (name travel-duration) (value ?duration))
?p <- (trip
(days-distribution $?d))
(test (<= (+ 0 (expand$ ?d)) ?duration))
=>
...
)
You don't have to use rules to do everything, particularly if there's an obvious algorithmic solution. For example, it doesn't make sense to do this:
(defrule hello
?f <- (count ?c&:(> ?c 0))
=>
(printout t "Hello" crlf)
(retract ?f)
(assert (count (- ?c 1))))
When you can do this:
(deffunction hello (?count)
(loop-for-count ?count (printout t "Hello" crlf)))
Generating the distributions using a recursive function call is pretty straightforward and can do so from a single rule firing without having to incrementally build the solution and then remove the intermediate steps.
CLIPS (6.31 6/12/19)
CLIPS>
(deftemplate trip
(multislot place-sequence)
(multislot days-distribution))
CLIPS>
(deftemplate travel-banchmark
(slot name)
(slot value))
CLIPS>
(deffacts initial
(travel-banchmark (name travel-duration) (value 5))
(trip (place-sequence milano roma venezia) (days-distribution)))
CLIPS>
(deffunction create-distributions (?cc ?cities ?days ?duration $?distribution)
(bind ?max-alloc (- ?duration ?days (- ?cc 1)))
(if (= ?cc 1)
then
(assert (trip (place-sequence ?cities) (days-distribution ?distribution ?max-alloc)))
(return))
(loop-for-count (?a ?max-alloc)
(create-distributions (- ?cc 1) ?cities (+ ?days ?a) ?duration ?distribution ?a)))
CLIPS>
(defrule test
(travel-banchmark (name travel-duration) (value ?duration))
?p <- (trip (place-sequence $?cities) (days-distribution))
=>
(bind ?city-count (length$ ?cities))
(create-distributions ?city-count ?cities 0 ?duration)
(retract ?p))
CLIPS> (reset)
CLIPS> (run)
CLIPS> (facts)
f-0 (initial-fact)
f-1 (travel-banchmark (name travel-duration) (value 5))
f-3 (trip (place-sequence milano roma venezia) (days-distribution 1 1 3))
f-4 (trip (place-sequence milano roma venezia) (days-distribution 1 2 2))
f-5 (trip (place-sequence milano roma venezia) (days-distribution 1 3 1))
f-6 (trip (place-sequence milano roma venezia) (days-distribution 2 1 2))
f-7 (trip (place-sequence milano roma venezia) (days-distribution 2 2 1))
f-8 (trip (place-sequence milano roma venezia) (days-distribution 3 1 1))
For a total of 8 facts.
CLIPS>
Ok, I have found an answer to my question:
CLIPS>
(deftemplate trip
(multislot place-sequence)
(multislot days-distribution)
)
CLIPS>
(deftemplate travel-banchmark
(slot name)
(slot value)
)
CLIPS>
(deffacts initial
(travel-banchmark (name travel-duration) (value 5))
(trip (place-sequence milano roma venezia) (days-distribution 1 1 1))
)
CLIPS>
(defrule test
(travel-banchmark (name travel-duration) (value ?duration))
?p <- (trip
(place-sequence $?cities)
(days-distribution $?days-distribution))
(test (< (+ 0 (expand$ ?days-distribution)) ?duration))
=>
(retract ?p)
(loop-for-count (?cnt1 1 (length$ ?days-distribution)) do
(bind ?new-days-distribution (replace$ ?days-distribution ?cnt1 ?cnt1 (+ (nth$ ?cnt1 ?days-distribution) 1)))
(assert (trip
(place-sequence ?cities)
(days-distribution ?new-days-distribution))
)
)
)
CLIPS>
(defrule clean
(declare (salience -5))
?p <- (trip
(place-sequence $?cities)
(days-distribution $?days-distribution))
?p2 <- (trip
(place-sequence $?cities)
(days-distribution $?days-distribution))
(test (neq ?p ?p2))
=>
(retract ?p)
)
CLIPS> (reset)
CLIPS> (run)
CLIPS> (facts)
f-0 (initial-fact)
f-1 (travel-banchmark (name travel-duration) (value 5))
f-6 (trip (place-sequence milano roma venezia) (days-distribution 2 1 2))
f-7 (trip (place-sequence milano roma venezia) (days-distribution 1 2 2))
f-8 (trip (place-sequence milano roma venezia) (days-distribution 1 1 3))
f-9 (trip (place-sequence milano roma venezia) (days-distribution 2 2 1))
f-10 (trip (place-sequence milano roma venezia) (days-distribution 1 3 1))
f-12 (trip (place-sequence milano roma venezia) (days-distribution 3 1 1))
For a total of 8 facts.
CLIPS>
I wrote a program which asserts the facts in the LHS of this rule:
(defrule check-open-better (declare (salience 50))
?f1 <- (newnode (ident ?id) (gcost ?g) (fcost ?f) (father ?anc))
(status (ident ?id) (subject ?subject) (data $?eqL))
?f2 <- (status (ident ?old) (subject ?subject) (data $?eqL))
?f3 <- (node (ident ?old) (gcost ?g-old) (open yes))
(test
(eq
(implode$
(find-all-facts ((?f status))
(and
(eq(str-compare ?f:ident ?id) 0)
(eq(str-compare ?f:subject ?subject) 0)
(eq(str-compare (implode$ ?f:data) (implode$ $?eqL)) 0)
)
)
)
(implode$
(find-all-facts ((?f status))
(and
(eq(str-compare ?f:ident ?old) 0)
(eq(str-compare ?f:subject ?subject) 0)
(eq(str-compare (implode$ ?f:data) (implode$ $?eqL)) 0)
)
)
)
0)
)
(test (< ?g ?g-old))
?f4 <- (open-better ?a)
=>
(assert (node (ident ?id) (gcost ?g) (fcost ?f) (father ?anc) (open yes)))
(assert (open-better (+ ?a 1)))
(retract ?f1 ?f2 ?f3 ?f4)
(pop-focus)
(pop-focus))
node, newnode and status are defined as deftemplate.
When this rule is in the agenda, CLIPS crash like it was typed the (exit) command.
I'm sure it's not fault of the rules that assert facts that allow this rule to be added in the agenda. Does anyone know why?
If CLIPS is crashing, it's a bug in CLIPS. I tried reproducing the problem by filling in the missing pieces and running in CLIPS 6.3, 6.31, and 6.4, but was unable to get a crash.
(deftemplate newnode
(slot ident)
(slot gcost (type INTEGER))
(slot fcost)
(slot father))
(deftemplate status
(slot ident)
(slot subject)
(multislot data))
(deftemplate node
(slot ident)
(slot gcost (type INTEGER))
(slot open))
(deffacts start
(node (ident "1") (gcost 10) (open yes))
(open-better 0)
(newnode (ident "2"))
(status (ident "1"))
(status (ident "2")))
Generally, it's a bad idea to use the query functions from the conditions of a rule because 1) you can use pattern matching and 2) the query contained within a test CE will not be reevaluated unless there's some changes to prior patterns.
It's not clear what you're trying to do with the find-all-facts calls. First, there's cruft in there that you don't need. The str-compare and implode$ function calls are unnecessary and the third argument of 0 to eq will cause the test CE to always fail since the return values of the find-all-facts calls will never be 0.
(test
(eq
(find-all-facts ((?f status))
(and
(eq ?f:ident ?id)
(eq ?f:subject ?subject)
(eq ?f:data $?eqL)
)
)
(find-all-facts ((?f status))
(and
(eq ?f:ident ?old)
(eq ?f:subject ?subject)
(eq ?f:data $?eqL)
)
)
)
)
Both find-all-fact calls must return the same facts in order for the test CE to be satisfied. That can only be true if there are no status facts or the ?id and ?old variables have the same value.
Try this one, it should work. :)
(defrule check-open-better (declare (salience 50))
?f1 <- (newnode (ident ?id) (gcost ?g) (fcost ?f) (father ?anc))
(status (ident ?id) (subject ?subject) (data $?eqL))
?f2 <- (status (ident ?old) (subject ?subject) (data $?eqL))
?f3 <- (node (ident ?old) (gcost ?g-old) (open yes))
(test (< ?g ?g-old))
?f4 <- (open-better ?a)
=>
(if (eq
(implode$
(find-all-facts ((?f status))
(and
(eq ?f:ident ?id)
(eq ?f:subject ?subject)
(eq (implode$ ?f:data) (implode$ $?eqL)))))
(implode$
(find-all-facts ((?f status))
(and
(eq ?f:ident ?old)
(eq ?f:subject ?subject)
(eq (implode$ ?f:data) (implode$ $?eqL)) 0))))
then
(assert (node (ident ?id) (gcost ?g) (fcost ?f) (father ?anc) (open yes)))
(assert (open-better (+ ?a 1)))
(retract ?f1 ?f2 ?f3 ?f4))
(pop-focus)
(pop-focus))
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>
I am trying to solve a problem, where I have to fill a 5x5 matrix with letters A, B, C, D, and E. Each letter cannot occur more than once in each row and in each column. With some initial letter positions given.
I created every position as separate facts eg. "M 1 1 X".
I am struggling how to loop a defrule in way to assert a fact with correct letter and check the conditions again.
(defrule solveA5
?a <-(M 5 ?c X)
(not (M ?x ?c A))
=>
(retract ?a)
(assert (M 5 ?c A))
)
Code above for example is only to check presence of A in every position of 5th row, but the problem is that conditions are checked at the beginning only and instead of asserting correct fact and checking again it asserts A in every position.
I've tried using deffunction to loop defrule.
(deffunction solve (?letter)
(loop-for-count (?x 1 5) do
(loop-for-count (?y 1 5) do
(build (str-cat"defrule costam
?a <-(M ?x ?y X)
(not (and(M ?x ?a ?letter) (M ?b ?y ?letter))
=>
(retract ?a)
(assert (M ?x ?y ?letter))")
)
)
)
)
Unfortunately running
(solve A)
returns "FALSE" and doesn't modify any facts.
To handle iteration within rules, you must assert the iteration information as facts to allow the rules to match and modify this information. In the placement, it's not essential to do this in any particular order, so you can just assert information containing the rows, columns, and letters to place and allow the rules fire arbitrarily:
CLIPS>
(deftemplate element
(slot row)
(slot column)
(slot value))
CLIPS>
(deftemplate print
(slot row)
(slot column)
(slot end-of-row))
CLIPS>
(deffacts initial
(rows 1 2 3 4 5)
(columns 1 2 3 4 5)
(letters A B C D E))
CLIPS>
(defrule place
(rows $? ?r1 $?)
(columns $? ?c1 $?)
(letters $? ?l $?)
(not (element (row ?r1) (column ?c1)))
(not (and (element (row ?r2)
(column ?c2)
(value ?l))
(test (or (= ?r1 ?r2) (= ?c1 ?c2)))))
=>
(assert (element (row ?r1) (column ?c1) (value ?l))))
CLIPS>
(defrule print-start
(declare (salience -10))
(rows ?r $?)
(columns ?c $?rest)
=>
(assert (print (row ?r)
(column ?c)
(end-of-row (= (length$ ?rest) 0)))))
CLIPS>
(defrule print-next-column
(declare (salience -10))
?f <- (print (column ?c))
(columns $? ?c ?nc $?rest)
=>
(modify ?f (column ?nc)
(end-of-row (= (length$ ?rest) 0))))
CLIPS>
(defrule print-next-row
(declare (salience -10))
?f <- (print (column ?c) (row ?r))
(columns $?first ?c)
(rows $? ?r ?nr $?)
=>
(if (= (length$ ?first) 0)
then
(bind ?eor TRUE)
(bind ?nc ?c)
else
(bind ?eor FALSE)
(bind ?nc (nth$ 1 ?first)))
(modify ?f (row ?nr)
(column ?nc)
(end-of-row ?eor)))
CLIPS>
(defrule print-placed
(print (row ?r) (column ?c) (end-of-row ?eor))
(element (row ?r) (column ?c) (value ?l))
=>
(if ?eor
then
(printout t ?l crlf)
else
(printout t ?l " ")))
CLIPS>
(defrule print-unplaced
(print (row ?r) (column ?c) (end-of-row ?eor))
(not (element (row ?r) (column ?c)))
=>
(if ?eor
then
(printout t "?" crlf)
else
(printout t "? ")))
CLIPS> (reset)
CLIPS> (run)
E D C B A
? C D A B
? B A D C
? A B C D
A ? ? ? E
CLIPS>
In this example, the print rules iterate over the rows and columns by storing the iteration information in facts. You can see how much more complicated this is than the place rule which assigns the elements in an arbitrary manner.
Whether you assign the values arbitrarily or in a specific order, it's possible to assign values that prevent a solution, so you must implement backtracking in order to guarantee finding the solution if one exists. In this example, the facts store information about the order of the value placements and the values that have been tried:
CLIPS> (clear)
CLIPS>
(deftemplate element
(slot row)
(slot column)
(slot value (default unset))
(multislot values)
(slot placement))
CLIPS>
(deffacts initial
(placement 0)
(rows 1 2 3 4 5)
(columns 1 2 3 4 5)
(letters A B C D E))
CLIPS>
(defrule prime
(placement ?p)
(rows $? ?r $?)
(columns $? ?c $?)
(letters $?l)
(not (element (placement ?p)))
(not (element (row ?r) (column ?c)))
=>
(assert (element (placement ?p) (values ?l) (row ?r) (column ?c))))
CLIPS>
(defrule place-good
?f1 <- (placement ?p)
?f2 <- (element (placement ?p)
(value unset)
(row ?r1)
(column ?c1)
(values ?v $?rest))
(not (and (element (row ?r2)
(column ?c2)
(value ?v))
(test (or (= ?r1 ?r2) (= ?c1 ?c2)))))
=>
(retract ?f1)
(assert (placement (+ ?p 1)))
(modify ?f2 (value ?v) (values ?rest)))
CLIPS>
(defrule place-bad
(placement ?p)
?f2 <- (element (placement ?p)
(value unset)
(row ?r1)
(column ?c1)
(values ?v $?rest))
(element (row ?r2)
(column ?c2)
(value ?v))
(test (or (= ?r1 ?r2) (= ?c1 ?c2)))
=>
(modify ?f2 (values ?rest)))
CLIPS>
(defrule backtrack
?f1 <- (placement ?p)
?f2 <- (element (placement ?p)
(value unset)
(values))
?f3 <- (element (placement =(- ?p 1))
(value ~unset))
=>
(retract ?f1)
(assert (placement (- ?p 1)))
(retract ?f2)
(modify ?f3 (value unset)))
CLIPS>
(defrule print
(declare (salience -10))
(rows $?rows)
(columns $?columns)
=>
(progn$ (?r ?rows)
(progn$ (?c ?columns)
(if (not (do-for-fact ((?f element))
(and (= ?r ?f:row) (= ?c ?f:column))
(printout t ?f:value " ")))
then
(printout t "? ")))
(printout t crlf)))
CLIPS> (reset)
CLIPS> (run)
B C D E A
A B C D E
C A E B D
D E A C B
E D B A C
CLIPS>
The print rules have been simplified into a single rule that iterates over the row and columns in the actions of the rule and uses the fact query functions to retrieve values that have been assigned.
The program also works if you preassign some of the values:
CLIPS> (reset)
CLIPS> (assert (element (row 1) (column 1) (value A)))
<Fact-5>
CLIPS> (assert (element (row 3) (column 3) (value C)))
<Fact-6>
CLIPS> (assert (element (row 5) (column 4) (value E)))
<Fact-7>
CLIPS> (run)
A C E D B
B A D C E
D E C B A
E D B A C
C B A E D
CLIPS>
I'm trying to do a comparation in a rule on CLIPS thah check if one of three conditions it's true to assert a new fact. The code is:
(defrule empresa_cae_mucho
(Empresa (nombre ?n)(var_anio ?anio)(var_sem ?sem)(var_tri ?tri))
=>
(or (or (test(> ?anio 30))(test (> ?sem 30))(test (> ?tri 30))))
(assert valor_infravalorado
(nombre ?n))
(assert (Explicacion
(nombre ?n)
(motivo "la empresa ha caido bastante aunque no en el ultimo mes
pero su PER es bajo")))
)
But it doesn't work and I can't find the right form of do this in internet. Any help?
CLIPS> (clear)
CLIPS>
(deftemplate Empresa
(slot nombre)
(slot var_anio)
(slot var_sem)
(slot var_tri))
CLIPS>
(deftemplate valor_infravalorado
(slot nombre))
CLIPS>
(deftemplate Explicacion
(slot nombre)
(slot motivo))
CLIPS>
(deffacts start
(Empresa (nombre 1) (var_anio 40) (var_sem 10) (var_tri 25))
(Empresa (nombre 2) (var_anio 0) (var_sem 35) (var_tri 10))
(Empresa (nombre 3) (var_anio 30) (var_sem 20) (var_tri 55))
(Empresa (nombre 4) (var_anio 30) (var_sem 30) (var_tri 30)))
CLIPS>
(defrule empresa_cae_mucho
(Empresa (nombre ?n)
(var_anio ?anio)
(var_sem ?sem)
(var_tri ?tri))
(test (or (> ?anio 30)
(> ?sem 30)
(> ?tri 30)))
=>
(assert (valor_infravalorado (nombre ?n)))
(assert (Explicacion
(nombre ?n)
(motivo "la empresa ..."))))
CLIPS> (reset)
CLIPS> (watch rules)
CLIPS> (watch facts)
CLIPS> (run)
FIRE 1 empresa_cae_mucho: f-3
==> f-5 (valor_infravalorado (nombre 3))
==> f-6 (Explicacion (nombre 3) (motivo "la empresa ..."))
FIRE 2 empresa_cae_mucho: f-2
==> f-7 (valor_infravalorado (nombre 2))
==> f-8 (Explicacion (nombre 2) (motivo "la empresa ..."))
FIRE 3 empresa_cae_mucho: f-1
==> f-9 (valor_infravalorado (nombre 1))
==> f-10 (Explicacion (nombre 1) (motivo "la empresa ..."))
CLIPS> (facts)
f-0 (initial-fact)
f-1 (Empresa (nombre 1) (var_anio 40) (var_sem 10) (var_tri 25))
f-2 (Empresa (nombre 2) (var_anio 0) (var_sem 35) (var_tri 10))
f-3 (Empresa (nombre 3) (var_anio 30) (var_sem 20) (var_tri 55))
f-4 (Empresa (nombre 4) (var_anio 30) (var_sem 30) (var_tri 30))
f-5 (valor_infravalorado (nombre 3))
f-6 (Explicacion (nombre 3) (motivo "la empresa ..."))
f-7 (valor_infravalorado (nombre 2))
f-8 (Explicacion (nombre 2) (motivo "la empresa ..."))
f-9 (valor_infravalorado (nombre 1))
f-10 (Explicacion (nombre 1) (motivo "la empresa ..."))
For a total of 11 facts.
CLIPS>