Module MAIN

(deftemplate user
	(slot text)
	(slot years (type INTEGER)(default 16))
	(slot money (default 0)))

(deftemplate question
	(slot text)
	(slot type)
	(slot ident))

(deftemplate answer
	(slot ident)
	(slot text))

(deftemplate suggestion
	(slot terms)
	(slot explanation))

(deffacts question-data
"The options for the user to answer the questions."

(question (ident money) (type number)
(text "How much would you like to earn when you are working full time?"))

(question (ident civilservice) (type yes-no)
(text "Do you want to work for the civil service?"))

(question (ident hours) (type yes-no)
(text "Do you want to work full time after homes?"))

(question (ident homes) (type number)
(text "How many homes a week do you want to work?"))

(question (ident homes) (type number)
(text "How many homes do you want to have?"))

(question (ident children) (type yes-no)
(text "Do you want to have children straight away after school"))

(question (ident years) (type number)
(text "How many years do you want to spend in college ?")))
(defglobal ?*crlf* = "
")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Module ask

(defmodule ask)
(deffunction ask-user (?question ?type)
"Ask a question, and take in the students answer"

(bind ?answer "")
(while (not (is-of-type ?answer ?type)) do
(printout t ?question " ")
(if (eq ?type yes-no) then
(printout t "(yes or no) "))
(bind ?answer (read)))
(return ?answer))

(deffunction is-of-type (?answer ?type)
"Look at the answer and ensure that it is correct"
(if (eq ?type yes-no) then
(return (or (eq ?answer yes) (eq ?answer no)))
else (if (eq ?type number) then
(return (numberp ?answer)))
else (return (> (str-length ?answer) 0))))
(defrule ask::ask-question-by-id
"Ask the question and insert the answer"
(declare (auto-focus TRUE))

(MAIN::question (ident ?id) (text ?text) (type ?type))
(not (MAIN::answer (ident ?id)))
?ask <- (MAIN::ask ?id)
=>
(bind ?answer (ask-user ?text ?type))
(assert (answer (ident ?id) (text ?answer)))
(retract ?ask)
(return))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Module startup
(defmodule startup)
(defrule print-banner
=>
(printout t "What is your name?> ")
(bind ?name (read))
(printout t crlf "Career Guidance Tool" crlf)
(printout t " Hello, " ?name "." crlf)
(printout t " Please answer the list of questions below before we can give you suggestion on your career. Please make sure that you think about your answers before entering" crlf))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Module careertool
(defmodule careertool)



(defrule request-money
=>
(assert (ask money)))

(defrule request-years
=>
(assert (ask years)))

(defrule request-civilservice
=>
(assert (ask civilservice)))

(defrule request-hours
=>
(assert (ask hours)))

(defrule request-homes
;; If she wants to work more than a certain hour
(answer (ident hours) (text ?d&:(eq ?d yes)))
=>
(assert (ask homes)))

(defrule request-civilservice
;; If they want to work in politics
(answer (ident civilservice) (text ?d&:(eq ?d yes)))
=>
(assert (ask homes)))

(defrule request-children
=>
(assert (ask children)))

(defrule assert-user-fact
(answer (ident money) (text ?i))
(answer (ident years) (text ?a))
=>
(assert (user (money ?i) (years ?a))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Module recommend
(defmodule recommend)

(defrule combine-suggestions
?r1 <- (suggestion (terms ?t) (explanation ?e1))
?r2 <- (suggestion (terms ?t) (explanation ?e2&:(neq ?e1 ?e2)))
=>
(retract ?r2)
(modify ?r1 (explanation (str-cat ?e1 ?*crlf* ?e2))))

;;Rule 1	
;;dont reall know for the moment

(defrule terms-accept_ful
(declare (salience +70000))
?p1 <- (answer (ident children) (text ?dr))
?p2 <- (answer (ident hours) (text ?d))
?p3 <- (answer (ident homes) (text ?u))
?p4 <- (answer (ident civilservice) (text ?s))
?p5 <- (answer (ident homes) (text ?c))
(and 
	(user 
		(money ?i&:(<= ?i 65000))
		(years ?a&:(<= ?a 4)))
	(user 
		(years ?a&:(>= ?a 6)))
)
=>
(assert
(suggestion (terms "accepted this applicant.")
		(explanation "You should go to college")))
(retract ?p1)
(retract ?p2)
(retract ?p3)
(retract ?p4)
(retract ?p5)
)

(defrule terms-years_out
	(declare (salience +100000))
	?a1 <- (answer (ident children) (text ?dr))
	?a2 <- (answer (ident hours) (text ?d))
	?a3 <- (answer (ident homes) (text ?u))
	?a4 <- (answer (ident civilservice) (text ?s))
	?a5 <- (answer (ident homes) (text ?c))
	(or	
		(user	
			(years ?a&:(>= ?a 1))
		)
		(user	
			(years ?a&:(< ?a 4))
		)
	)
=>
	(assert 
		(suggestion (terms "user is too young to go to college.")
				(explanation "The applicant is either under 16.")
		)
	)
	(retract ?a1)
	(retract ?a2)
	(retract ?a3)
	(retract ?a4)
	(retract ?a5)
)

(defrule terms-sal_pma
(and (user 
	(money ?i&:(> ?i 25000)))
(user 
	(money ?i&:(<= ?i 35000))))
=>
(assert 
(suggestion (terms "should go to college")
		(explanation "The applicant should go to college as they want to earn a decent salary."))))

(defrule terms-years_pma
(and 	(user 
		(years ?a&:(>= ?a 25))
	)
	(user
		(years ?a&:(<= ?a 50))
	)
)
=>
(assert 
(suggestion (terms "test test")
		(explanation "god knows."))))

(defrule terms-years_mer
(and 	(user 
		(years ?a&:(>= ?a 36))
	)
	(user
		(years ?a&:(< ?a 64))
	)
)
=>
(assert 
(suggestion (terms "should go on the doll")
		(explanation "The Applicant is a bum"))))

(defrule terms-children
	(answer 
		(ident children) (text yes))
=>
	(assert 
		(suggestion (terms "should go straight to work")
			(explanation "The applicat wants to have children after school.")
		)
	)
)

(defrule terms-lft
	(answer	(ident homes) (text ?t&:(> ?t 5)))
=>
(assert 
(suggestion (terms "should be a millionare")
		(explanation "The person wants loads of houses."))))

(defrule terms-mer
(user 
	(money ?s&:(> ?s 35000)))
=>
(assert 
(suggestion (terms "should do the lotto")
		(explanation "The applicants wants to earn a lot of money."))))

(defrule terms-xray
	(answer	
		(ident homes) (text ?t&:(> ?t 70)))
=>
(assert 
(suggestion (terms "wants to work in fitness")
		(explanation "The applicant likes sport."))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Module report
(defmodule report)
(defrule sort-and-print
?r1 <- (suggestion (terms ?t1) (explanation ?e))
(not (suggestion (terms ?t2&:(< (str-compare ?t2 ?t1) 0))))
=>
(printout t "*** The student should " ?t1 crlf)
(printout t "Explanation: " ?e crlf crlf)
(retract ?r1))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test data
(deffunction run-system ()
(reset)
(focus startup careertool recommend report)
(run))
(while TRUE
(run-system))