用CLIPS模拟P-System

这两天我用CLIPS模拟了一个简单的P-System实例。即计算n的平方的P-System。下面是模拟的一些思路及代码。

事实上，用CLIPS模拟文法类的规则是相对简单的，因为CLIPS本身就是专家系统，而专家系统就是一些规则跟知识库。但是，写过一些CLIPS程序后，我才发现这种简单也是相对的。因为对于一个写惯诸如Ｃ语言等命令式语言的人来说，CLIPS缺少了变量，循环等经典操作，如果这一思想没转变过来，写起程序来也是很困难的。

这个计算n平方的P-System可以表达如下：

[ [ [a->ad a->de f->ff    af ](3) [ ](4) ] d->b b->b(c,in(4)) (ff->af)>(f->ae)  ](2) ](1)  e代表溶解

在CLIPS下实现如下：

初始事实如下：

(reset)
(assert (parallel m3_1))
(assert (maxplay 5))
(assert (curmem m3))
(assert (numplayed 0))
(assert (m3-a (value 1)))
(assert (m3-b (value 0)))
(assert (m3-c (value 0)))
(assert (m3-d (value 0)))
(assert (m3-f (value 1)))
(assert (m4-c (value 0)))
(agenda)
(run)
(facts)

规则跟模板定义如下：

(deftemplate m3-a
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m3-b
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m3-c
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m3-d
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m3-f
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m2-a
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m2-b
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m2-c
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m2-d
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m2-f
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m1-a
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m1-b
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m1-c
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m1-d
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m1-f
 (slot value
 (type NUMBER)
 (default 0)))
 
(deftemplate m4-a
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m4-b
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m4-c
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m4-d
 (slot value
 (type NUMBER)
 (default 0)))

(deftemplate m4-f
 (slot value
 (type NUMBER)
 (default 0)))

(defrule m3-1
 (m3-a (value ?n&:(>= ?n 1)))
 ?f0 <- (m3-d (value ?m))
 ?f1 <- (curmem m3)
 (maxplay ?t)
 ?f2 <- (numplayed ?h&:(<= ?h ?t))
 ?f3 <- (parallel m3_1)
=>
 (bind ?m (+ ?m ?n))
 (bind ?h (+ ?h 1))
 (retract ?f2)
 (assert (numplayed ?h))
 (retract ?f0)
 (assert (m3-d (value ?m)))
 (retract ?f3)
 (assert (parallel m3_2)))

(defrule m3-2
 ?f0 <- (m3-f (value ?n&:(>= ?n 1)))
 ?f1 <- (curmem m3)
 ?f2 <- (parallel m3_2)
=>
 (bind ?n (* ?n 2))
 (retract ?f0)
 (assert (m3-f (value ?n)))
 (retract ?f2)
 (assert (parallel m3_1)))

(defrule m3-3
 ?f0 <- (m3-a (value ?n&:(>= ?n 1)))
 ?f1 <- (curmem m3)
 (maxplay ?t)
 ?f2 <- (numplayed ?h&:(> ?h ?t))
 ?f3 <- (m3-b (value ?bb))
 ?f4 <- (m3-c (value ?cc))
 ?f5 <- (m3-d (value ?dd))
 ?f6 <- (m3-f (value ?ff))
=>
 (bind ?n (- ?n 1))
 (retract ?f0)
 (assert (m3-a (value ?n)))
 (retract ?f1)
 (assert (curmem m2))
 (retract ?f3)
 (assert (m3-b (value 0)))
 (retract ?f4)
 (assert (m3-c (value 0)))
 (retract ?f5)
 (assert (m3-d (value 0)))
 (retract ?f6)
 (assert (m3-f (value 0)))
 (assert (m2-a (value ?n)))
 (assert (m2-b (value ?bb)))
 (assert (m2-c (value ?cc)))
 (assert (m2-d (value ?dd)))
 (assert (m2-f (value ?ff)))
 (assert (parallel m2_1)))

(defrule m2-1
 ?f0 <- (m2-d (value ?n&:(>= ?n 1)))
 ?f1 <- (parallel m2_2)
 ?f2 <- (m2-b (value ?t))
=>
 (retract ?f0)
 (assert (m2-d (value 0)))
 (retract ?f1)
 (assert (parallel m2_1))
 (retract ?f2)
 (assert (m2-b (value (+ ?n ?t)))))

(defrule m2-2
 ?f0 <- (m2-b (value ?n&:(>= ?n 1)))
 ?f1 <- (parallel m2_3)
 ?f2 <- (m4-c (value ?m))
=>
 (retract ?f1)
 (assert (parallel m2_1))
 (retract ?f2)
 (assert (m4-c (value (+ ?m ?n)))))

(defrule m2-3
 ?f0 <- (m2-f (value ?n&:(>= ?n 2)))
 ?f1 <- (m2-a (value ?t))
 ?f2 <- (parallel m2_1)
=>
 (bind ?n (+ (div ?n 2) (mod ?n 2)))
 (retract ?f0)
 (assert (m2-f (value ?n)))
 (retract ?f1)
 (assert (m2-a (value (+ ?t ?n))))
 (retract ?f2)
 (assert (parallel m2_3))
 (assert (parallel m2_2)))

(defrule m2-4
 ?f0 <- (m2-f (value ?n&:(= ?n 1)))
 ?f1 <- (m2-a (value ?t))
 ?f2 <- (m2-b (value ?bb))
 ?f3 <- (m2-c (value ?cc))
 ?f4 <- (m2-d (value ?dd))
 ?f5 <- (m2-f (value ?ff))
=>
 (retract ?f0)
 (assert (m2-f (value 0)))
 (retract ?f1)
 (assert (m2-a (value 0)))
 (retract ?f2)
 (assert (m2-b (value 0)))
 (retract ?f3)
 (assert (m2-c (value 0)))
 (retract ?f4)
 (assert (m2-d (value 0)))
 (retract ?f5)
 (assert (m1-a (value (+ ?t 1))))
 (assert (m1-b (value ?bb)))
 (assert (m1-c (value ?cc)))
 (assert (m1-d (value ?dd)))
 (assert (m1-f (value ?ff))))

 具体的注释没有详细说明，相信也不难看懂。