在 CLIPS 中循环 defrule
Looping defrule in CLIPS
我正在尝试解决一个问题，我必须用字母 A、B、C、D 和 E 填充一个 5x5 矩阵。每个字母在每一行和每一列中不能出现超过一次。给出了一些首字母位置。
我将每个职位创建为单独的事实，例如。 "M 1 1 X"。
我正在努力如何循环一个 defrule 以用正确的字母断言一个事实并再次检查条件。
(defrule solveA5
?a <-(M 5 ?c X)
(not (M ?x ?c A))
=>
(retract ?a)
(assert (M 5 ?c A))
)
例如上面的代码只是检查第 5 行的每个位置是否存在 A，但问题是只在开始时检查条件，而不是断言正确的事实并再次检查它在每个位置都断言 A .
我试过使用 deffunction 来循环 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))")
)
)
)
)
可惜运行
(solve A)
returns "FALSE" 并且不修改任何事实。
要处理规则内的迭代，您必须将迭代信息断言为事实，以允许规则匹配和修改此信息。在放置中，没有必要以任何特定顺序执行此操作，因此您可以只断言包含要放置的行、列和字母的信息，并允许任意触发规则：
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>
在此示例中，打印规则通过将迭代信息存储在事实中来迭代行和列。你可以看到这比以任意方式分配元素的放置规则要复杂得多。
无论您是任意分配值还是按特定顺序分配值，分配的值都可能会阻止解决方案，因此您必须实施回溯以保证找到解决方案（如果存在）。在此示例中，事实存储有关值放置顺序和已尝试的值的信息：
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>
打印规则已简化为单个规则，该规则遍历规则操作中的行和列，并使用事实查询函数检索已分配的值。
如果您预先分配了一些值，该程序也可以运行：
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>
我正在尝试解决一个问题，我必须用字母 A、B、C、D 和 E 填充一个 5x5 矩阵。每个字母在每一行和每一列中不能出现超过一次。给出了一些首字母位置。 我将每个职位创建为单独的事实，例如。 "M 1 1 X"。 我正在努力如何循环一个 defrule 以用正确的字母断言一个事实并再次检查条件。
(defrule solveA5
?a <-(M 5 ?c X)
(not (M ?x ?c A))
=>
(retract ?a)
(assert (M 5 ?c A))
)
例如上面的代码只是检查第 5 行的每个位置是否存在 A，但问题是只在开始时检查条件，而不是断言正确的事实并再次检查它在每个位置都断言 A .
我试过使用 deffunction 来循环 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))")
)
)
)
)
可惜运行
(solve A)
returns "FALSE" 并且不修改任何事实。
要处理规则内的迭代，您必须将迭代信息断言为事实，以允许规则匹配和修改此信息。在放置中，没有必要以任何特定顺序执行此操作，因此您可以只断言包含要放置的行、列和字母的信息，并允许任意触发规则：
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>
在此示例中，打印规则通过将迭代信息存储在事实中来迭代行和列。你可以看到这比以任意方式分配元素的放置规则要复杂得多。
无论您是任意分配值还是按特定顺序分配值，分配的值都可能会阻止解决方案，因此您必须实施回溯以保证找到解决方案（如果存在）。在此示例中，事实存储有关值放置顺序和已尝试的值的信息：
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>
打印规则已简化为单个规则，该规则遍历规则操作中的行和列，并使用事实查询函数检索已分配的值。
如果您预先分配了一些值，该程序也可以运行：
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>