CLIPS中的循环规则

时间:2017-05-20 20:21:31

标签: 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. / p>

我尝试使用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)

返回“FALSE”并且不会修改任何事实。

1 个答案:

答案 0 :(得分:0)

要处理规则内的迭代,必须将迭代信息作为事实断言,以允许规则匹配和修改此信息。在展示位置中,按任何特定顺序执行此操作并非必不可少,因此您只需断言包含行,列和字母的信息即可放置并允许规则随意触发:

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>