Rules for arranging people age wise and gender wise - jess

Question

This is my whole program for sorting people gender wise and age wise. The older should come before younger and the female should come male.
(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)
The code is not giving any error but also not getting expected output.

Answer 1

Here is the code.
(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)

Answer 2

Here is an answer to your question which will, perhaps, not be easy to understand. However, I'll try and add lots of comments.
The fundamental idea of this "sort" is to identify person facts in the sort order: older before younger, female before male. After finding the winner fact it is retracted, so that the rule can fire again with the second best, and so on, until all person facts have been retracted.
Here is the rule in pseudo-code:
(defrule findFirst
?p1 <- (person)
not ?p2 <- (person ranked before ?p1)
=>
(retract ?p1))
Since the ranking involves more than one slot it is best written as a function which can be called with ?p1 and ?p2 as arguments. The compare
function can be written to return -1, 0 or +1, just like Java's compare methods.
(defrule findFirst
?p1 <- (person)
(not (and ?p2 <- (person)
(test (< (comparePerson ?p2 ?p1) 0))))
=>
(retract ?p1))
It would be nice if we could write the compare function in a flexible way so that another sort order wouldn't require a complete new function. This can be done by using lambdas - anonymous deffunctions - each of which compares just one slot. Here are the ones for age and gender, assigned to globals so that they are accessible from a rule's 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)))))
(Note the reversal of ?pa and ?pb to get descending age order.) We can now write the comparePerson function, which receives two person facts (?pa, ?pb) and a list of 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))))
And now the rule, triggered with another value for the phase fact:
(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))
Note: person facts are best assembled as soon as a correct name has been entered. There's no need to create and insert the name fact.