Question

这是我的整个计划，用于对性别明智和年龄进行分类。年长者应该在年轻之前到来，女性应该是男性。

(deftemplate person  (slot gender)  
                (slot age (type INTEGER))   
                (slot name))


(deffacts initial-phase
   (phase choose-gender)
(phase choose-age)
(phase choose-name))

; ********
; DEFFUNCTIONS
; ********

(deffunction ask-start-again ()
  (printout t "Enter another person? (y/n) ")
  (if (eq (read) y) then
    (assert (phase choose-gender)
    (phase choose-age)
    (phase choose-name))))


;RULES

(defrule gender-select
    (phase choose-gender)
    =>
    (printout t "what is your gender (Male: m "
        "Female: f)? ")
    (assert (gender-select (read))))

(defrule good-gender-choice
   ?phase <- (phase choose-gender)
   ?choice <- (gender-select ?gender&:(or (eq ?gender m) (eq ?gender f)))
   =>
   (retract ?phase ?choice)
(assert (gender ?gender))
   (assert (phase select-age)))

(defrule bad-gender-choice 
   ?phase <- (phase choose-gender)
   ?choice <- (gender-select ?player&~m&~f)
   =>
   (retract ?phase ?choice)
   (assert (phase choose-gender))
   (printout t "Choose m or f." crlf))


(defrule age-select
   (phase select-age)
   =>
   (printout t "What is your age? ")
   (assert (age-select (read))))

(defrule good-age-choice
   ?phase <- (phase select-age)
   ?choice <- (age-select ?age&:(integerp ?age)
                                &:(> ?age 0))
   =>
   (retract ?phase ?choice)
   (assert (age ?age))
(assert (phase select-name)))

(defrule bad-age-choice
   ?phase <- (phase select-age)
   ?choice <- (age-select ?age&:(or (not (integerp ?age))
                                      (<= ?age 0)))
   =>
   (retract ?phase ?choice)
   (assert (phase select-age))
   (printout t "Choose an integer greater than zero."
               crlf))

(defrule name-select
   (phase select-name)
   =>
   (printout t "What is your name? ")
   (assert (name-select (read))))

(defrule good-name-choice
   ?phase <- (phase select-name)
   ?choice <- (name-select ?name&:(or (not (integerp ?name))))
   =>
   (retract ?phase ?choice)
   (assert (name ?name)))

(defrule bad-name-choice
   ?phase <- (phase select-name)
   ?choice <- (name-select ?name&:(integerp ?name))
   =>
   (retract ?phase ?choice)
   (assert (phase select-name))
   (printout t "Please enter a name."
               crlf))

(defrule old-female-first
?gender <- (gender f)  
?age <- (age ?b&:(> ?b 35))
     =>
   (printout t "Person is female & older. This Person must go first!" crlf)
   (retract ?gender)
   (retract ?age)
   (ask-start-again))

(defrule young-female-third
?gender <- (gender f)  
?age <- (age ?age&:(<= ?age 35))
   =>
   (printout t "Person is female & younger. This Person must go after older males!" crlf)
   (retract ?gender)
   (retract ?age)
   (ask-start-again))

(defrule old-male-second
?gender <- (gender m)  
?age <- (age ?a&:(> ?a 35))
   =>
   (printout t "Person is male & older. This Person must go after older females!" crlf)
   (retract ?gender)
   (retract ?age)
   (ask-start-again))

(defrule young-male-last
 ?gender <- (gender m)
?age <- (age ?age&:(<= ?age 35))
   =>
   (printout t "Person is male & younger. This Person must go after younger females!" crlf)
   (retract ?gender)
   (retract ?age)
   (ask-start-again))


(defrule print-all-persons
  (declare (salience -1000))
  (person (name ?name) (age ?age) (gender ?gender))
=>
  (printout t ?name ?age ?gender crlf))

(reset)
(run)

代码没有给出任何错误，但也没有得到预期的输出。

Answer 1

以下是您的问题的答案，或许不容易理解。但是，我会尝试添加大量评论。

这个＆＃34;排序＆＃34;的基本思想是按照排序顺序识别人事实：年龄较小，女性较年轻。在找到胜利者事实之后，它被撤回，以便规则可以再次以最好的方式开始，依此类推，直到所有人的事实都被撤回。

以下是伪代码中的规则：

(defrule findFirst
   ?p1 <- (person)
   not ?p2 <- (person ranked before ?p1)
=>
   (retract ?p1))

由于排名涉及多个插槽，因此最好将其编写为可以使用？p1和？p2作为参数调用的函数。比较函数可以写成返回-1,0或+1，就像Java的比较方法一样。

(defrule findFirst
   ?p1 <- (person)
   (not (and ?p2 <- (person)
            (test (< (comparePerson ?p2 ?p1) 0))))
=>
   (retract ?p1))

如果我们能够灵活地编写比较函数，那么另一种排序顺序就不需要一个完整的新函数。这可以通过使用lambdas - 匿名deffunctions来完成 - 每个都只比较一个槽。以下是年龄和性别的分配给全局变量，以便可以从规则的LHS访问：

(defglobal ?*compAge* = 
  (lambda (?pa ?pb)
    (- (fact-slot-value ?pb age) (fact-slot-value ?pa age) )))

(defglobal ?*compGender* =
  (lambda (?pa ?pb)
    (- (asc (fact-slot-value ?pa gender))
       (asc (fact-slot-value ?pb gender)))))

（注意反转？pa和？pb以获得降序年龄顺序。）我们现在可以编写comparePerson函数，它接收两个人的事实（？pa，？pb）和一个lambdas列表（$？comp）。

(deffunction comparePerson(?pa ?pb $?comp)
  ;; if a comparison with the first function yields a decision, return it
  (if (< ((nth$ 1 $?comp) ?pa ?pb) 0) then (return -1))
  (if (> ((nth$ 1 $?comp) ?pa ?pb) 0) then (return 1))
  ;; if this is the last function we have two equal persons: return 0
  (if (= (length$ $?comp) 1) then (return 0))
  ;; otherwise call the compare function with the remaining functions
  (return (comparePerson ?pa ?pb (rest$ $?comp))))

现在规则是用相位事实的另一个值触发的：

(defrule findFirst
  ?phase <- (phase sort-persons)
  ?p1 <- (person)
  (not (and ?p2 <- (person)
            (test (< (comparePerson ?p2 ?p1 ?*compAge* ?*compGender*) 0))))
=>
 (printout t (fact-slot-value ?p1 name) " selected" crlf)
 (retract ?p1))

注意：输入正确的名称后，最好汇总人员事实。没有必要创建和插入name事实。

Answer 2

这是代码。

(deftemplate Person (slot gender) (slot name) (slot age(type INTEGER)))

(deffunction validateName (?personname)
    (bind ?stringLen (str-length ?personname))  
    (bind ?index 1)
        (while (>= ?stringLen ?index)
            (bind ?currentChar (sub-string ?index ?index ?personname))
            (bind ?ASCIIValue (asc ?currentChar))
            (if (and (>= ?ASCIIValue 0) (<= ?ASCIIValue 64)) then (return 0))
            (if (and (>= ?ASCIIValue 91) (<= ?ASCIIValue 96)) then (return 0))
            (if (>= ?ASCIIValue 123) then (return 0))

            (bind ?index (+ ?index 1))
        )
        (return 1)
)

(deffunction getGender()
    (printout t "Enter Gender (M|F) : ")
    (bind ?localGender (read))

    (if (or (eq (upcase ?localGender) M) (eq (upcase ?localGender) F)) 
    then 
         (return ?localGender)
    )
    (printout t "Invalid Gender... Try Again..." crlf crlf)
    (return (getGender()))
)

(deffunction getName()
    (printout t "Enter Name : ")
    (bind ?localName (readline))

    (if (eq (validateName ?localName) 1) then (return ?localName))

    (printout t "Invalid Name... Try Again..." crlf crlf)
    (return (getName()))
)

(deffunction getAge()
    (printout t "Enter Age : ")
    (bind ?localAge (read))

    (if (integerp ?localAge) then (if (> ?localAge 0) then (return ?localAge)))

    (printout t "Invalid Age... Try Again..." crlf crlf)
    (return (getAge()))
)

(deffunction showAllPesron()
    (printout t crlf"-------------------------------" crlf)
    (printout t "         Person List           " crlf)
    (printout t "-------------------------------" crlf)
    (printout t "Gender |  Age  |  Name" crlf)
    (printout t "-------------------------------" crlf)
)

(deffunction getPersonDetail()
    (printout t crlf)
    (bind ?gender (getGender()))
    (bind ?name (getName()))
    (bind ?age (getAge()))

    (if (eq (upcase ?gender) M) then (assert (Person (gender M) (name ?name) (age ?age))))
    (if (eq (upcase ?gender) F) then (assert (Person (gender F) (name ?name) (age ?age))))  
    (printout t crlf)
)

(defrule show-person-order
   ?P <- (Person (gender ?gender1) (name ?name1) (age ?age1))
   (not (Person (age ?age2&:(> ?age2 ?age1))))
   =>
   (printout t ?gender1"         "?age1"      "?name1 crlf)
   (retract ?P)
)

(deffunction main()

    (printout t "Add another person? (Y|N) : ")
    (bind ?addAnother (read))

    (if (eq (upcase ?addAnother) Y) then (getPersonDetail()) (main()))  
)

(getPersonDetail())
(main())
(showAllPesron())
(run)
(reset)

安排人们明智和性别明智的规则

2 个答案: