按年龄和性别安排人员的规则

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

这是对您问题的回答，可能不太容易理解。但是，我会尝试添加很多评论。

这个 "sort" 的基本思想是按排序顺序识别人物事实：年长的在年轻的之前，女性在男性的之前。在找到获胜者事实后，它会被撤回，这样规则可以再次触发第二好的，依此类推，直到所有的人事实都被撤回。

这是伪代码中的规则：

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

由于排名涉及多个位置，因此最好将其编写为一个函数，可以用 ?p1 和 ?p2 作为参数调用。比较函数可以写入 return -1、0 或 +1，就像 Java 的比较方法一样。

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

如果我们能以灵活的方式编写比较函数，这样另一个排序顺序就不需要一个全新的函数，那就太好了。这可以通过使用 lambdas（匿名 deffunctions）来完成，每个 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) 和 a 列表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)

按年龄和性别安排人员的规则

Rules for arranging people age wise and gender wise

jess