(deftemplate question 
	"A complete question."
	(slot id)
	(slot type (default demographic))
	(slot desc (default "None"))
	(multislot quests)
	(multislot options)
	(slot count (default 0)))

(deftemplate dependency
   "A question depends on responses to another question."
   (slot qid)
   (slot dependson)
   (multislot options))

(deftemplate result
	"A place to store question resultes"
	(slot id)
	(slot answer))

;; The Questions and Answers
(deffacts questions
	(question (id 1) 
		(desc "Age") 
		(quests M "Your Age(M)" 
			F "Your Age(F)")
		(options 1 "Under 18" 
			2 "18-24" 
			3 "25-30" 
			4 "31-40" 
			5 "41-50" 
			6 "51-60" 
			7 "60+"))

	(question (id 8) 
		(desc "Relationship status") 
		(quests M "Current relationship status" 
			F "Current relationship status")
		(options 1 "Dating (living separately)" 
			2 "Engaged (living separately)" 
			3 "Married (living together)" 
			4 "Dating (living together)" 
			5 "Engaged (living together)" 
			6 "Married (separated)"))

	(question (id 12)
		(desc "Parent (or parent figures) in my life when I was growing up")
		(quests M "Parent (or parent figures) in my life when I was growing up"
			F "Parent (or parent figures) in my life when I was growing up")
		(options 1 "Mother and father"
			2 "Father"
			3 "Mother"))
	(dependency (qid 12)
      		(dependson 8)
      		(options 1 2 4 5))

	(question (id 20)
		(desc "Number of times previously married")
		(quests M "Number of times married (not counting this relationship)"
			F "Number of times married (not counting this relationship)")
		(options 1 "Not married before this relationship"
			2 "Once"
			3 "Twice"
			4 "Three times"
			5 "More than three times"))

	(question (id 22)
		(desc "Most recent marital relationship")
		(quests M "Your most recent marital relationship prior to this relationship"
			F "Your most recent marital relationship prior to this relationship")
		(options 1 "Widowed"
			2 "Divorced"))
   	(dependency (qid 22)
		(dependson 20)
		(options 2 3 4 5))

)
;; First rule to fire to get things going.
(defrule starter
	?init <- (initial-fact)
=>
	(retract ?init)

	(printout t "              ")
	(printout t "      Marriage Demographics Demo" crlf)
	(printout t "  " crlf)
	(printout t " Hit <cr> to start" crlf)
 	(printout t "  " crlf)
	(bind ?answer (readline))
	(assert (gender nil)))

;; We need to know the gender to ask the right question form
(defrule getgender
	?g <- (gender nil)
=>
	(printout t "What is your Gender? (M or F)" crlf)
 	(printout t "  " crlf)
	(printout t "  " crlf)
        (assert (gender (read)))
	(retract ?g))

;; Actually ask the next question	
(defrule askquestion
	(gender ?g)
	;; Match a question for which no answer is recorded as a result
	?q <- (question (id ?id) 
		(type demographic)
		;; Select the right form of question based on gender
		(quests $?before ?g ?thequest $?after)
		(options $?options)
		(count ?count))
	(not (result (id ?id) (answer ?)))
	;; Check if the dependencies for this question have been fufiled
	(or (not (dependency (qid ?id) (dependson ?) (options $?)))
	    (and (result (id ?did) (answer ?dresult))
	         (dependency (qid ?id) (dependson ?did) (options $?dependoptions & 
			:(member$ ?dresult $?dependoptions)))))
=>
	;; Display the question text (based on gender)
	(printout t ?thequest crlf)
	;; Display the list of possible answers
	(bind ?len (length$ $?options))
	(bind ?i 1)
	(while (<= ?i ?len) do
		(printout t (nth$ ?i $?options) ". " (nth$ (+ ?i 1) $?options) crlf)
		(bind ?i (+ ?i  2)))
	;; Ask for an answer, displaying range of answers possible
	(bind ?min (nth$ 1 $?options))
	(bind ?max (nth$ (- ?len 1) $?options))
	(printout t "(" ?min "-" ?max "): ")
	(bind ?answer (readline))
	;; Check if answer is in range
	(if (and (>= ?answer ?min) (<= ?answer ?max)) then
	    ;; Good answer, store in result object
	    (assert (result (id ?id) (answer (integer ?answer))))
	else
	    ;; If answer not in range, increment count to force reactivation of question
	    (printout t "Answer out of range, ignored" crlf crlf)
	    (modify ?q (count (+ ?count 1))))
)
	

-- JimSkon - 2011-06-02

Topic revision: r3 - 2011-06-03 - JimSkon
 
This site is powered by the TWiki collaboration platformCopyright &© by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding TWiki? Send feedback