To anyone, please do help me before viva next week. Still have problems
with the updating to the knowledge base.
Well, my expert system code is as such; there are a few functions in
the top-level cbr function( bottomest coding) that cannot work and
incomplete of purpose. It is done in Allegro Cl 6.0 without ide for
testing before using it with ide.
In brief, this expert system diagnose a sickness and that
1.in savenew function as below : solution is the adapted case which has
been obtained after the matching process. The question is how do I make
the parameter name change,e.g * kes11*the next *kes12* and so on? by
using dotimes and a variable *kes (i)* and increment i+1 ?
(defun savenew (solution)
(defparameter *kes11* solution))
2.The append function seem not to be working as I do not see the
appended solution being append to the existing knowledge base in
newcase.txt . How do I append the newly adapted solution with the
parameter *kes11* *kes12* to existing *kes-knowledgebase* which
already comprise the list of *kes1* *kes2*......*kes10* ?
(append(list *kes11*)*kes-knowledgebase*)
(WITH-OPEN-FILE (f "newcase.txt" :DIRECTION :OUTPUT :IF-DOES-NOT-EXIST
:create :IF-EXISTS :append)
(FORMAT f "~%~S" *kes-knowledgebase*))
3. Say if I want to add a new slot-name under the structure of problem,
how do i do that?
4. Full example code as below . Please reply asap anyone. Thank you.
(defstruct kes
problem
solution
result)
(defstruct problem
age
gender
race
badevents
drugabuse
medicalillness
prescribemed
familyhistory
pasthistory
birth
socialwithdrawal
depressedmood
lossinterest
weightloss
insomnia
psychomotorretard
fatigue
guilt
indecisive
suicide
duration)
(defstruct solution
outcome
factor
criteria
period
numberofsymptoms
result)
(defparameter *kes1*
(make-kes
:problem
(make-problem :age '(g3)
:gender '(male)
:race '(chinese)
:badevents 0
:drugabuse 0
:medicalillness 0
:prescribemed 0
:familyhistory 0
:pasthistory 0
:birth 0
:socialwithdrawal 0
:depressedmood 0
:lossinterest 0
:weightloss 1
:insomnia 1
:psychomotorretard 1
:fatigue 1
:guilt 1
:indecisive 1
:suicide 0
:duration '(d1))
:solution
(make-solution :outcome '(You have no major depression)
:factor '(This is because you have neither
depressed mood nor loss of interest)
:criteria '(You must have at least 1
mandatory symptom)
:period '(Symptoms have to be almost every
day for at least 2 weeks)
:numberofsymptoms 7)
:result 's))
(defparameter *kes2*
(make-kes
:problem
(make-problem :age '(g3)
:gender '(male)
:race '(indian)
:badevents 1
:drugabuse 0
:medicalillness 0
:prescribemed 0
:familyhistory 0
:pasthistory 0
:birth 0
:socialwithdrawal 0
:depressedmood 0
:lossinterest 0
:weightloss 0
:insomnia 0
:psychomotorretard 1
:fatigue 1
:guilt 1
:indecisive 1
:suicide 0
:duration '(d2))
:solution
(make-solution :outcome '(You have no major depression but
maybe exoeriencing bereavement)
:factor '(This is because you have neither
depressed mood nor loss of interest and have less than 5 symptoms
However you might be experiencing grief or bereavement due to loss of
event Please talk to your doctor about it or seek a therapist)
:criteria '(You must have at least one
mandatory symptom and 5 symptoms altogether)
:period '(Symptoms persist longer than 2
months accounted for bereavement)
:numberofsymptoms 4)
:result 's))
(defparameter *kes3*
(make-kes
:problem
(make-problem :age '(g3)
:gender '(female)
:race '(malay)
:badevents 1
:drugabuse 0
:medicalillness 0
:prescribemed 0
:familyhistory 0
:pasthistory 0
:birth 1
:socialwithdrawal 0
:depressedmood 1
:lossinterest 0
:weightloss 1
:insomnia 1
:psychomotorretard 1
:fatigue 1
:guilt 0
:indecisive 0
:suicide 0
:duration '(d2))
:solution
(make-solution :outcome '(You might have postpartum
depression that is experinced by mothers giving birth after a month)
:factor '(The symptoms show that you have
depression and giving birth further determine the type you have that is
postpartum Please consult your medical doctor for further reference)
:criteria '(Postpartum depression is a form
of clinical depression)
:period '(Symptoms persist longer at least
one month for postpartum depression)
:numberofsymptoms 5)
:result 's))
(defparameter *kes4*
(make-kes
:problem
(make-problem :age '(g4)
:gender '(male)
:race '(indian)
:badevents 0
:drugabuse 1
:medicalillness 0
:prescribemed 0
:familyhistory 1
:pasthistory 0
:birth 0
:socialwithdrawal 0
:depressedmood 1
:lossinterest 0
:weightloss 1
:insomnia 0
:psychomotorretard 1
:fatigue 1
:guilt 1
:indecisive 0
:suicide 0
:duration '(d2))
:solution
(make-solution :outcome '(You might have depression due to
substance)
:factor '(Major depression cannot be
diagnosed accurately as a medical illness as drug or alcohol substance
is involved Please consult your medical doctor for a physical exam and
further reference)
:criteria '(Symptoms for major depression
are not due to the direct physiological effects of drug abuse or
medication)
:period '(Symptoms occur at least every day
for at least two weeks)
:numberofsymptoms 5)
:result 's))
(defparameter *kes5*
(make-kes
:problem
(make-problem :age '(g4)
:gender '(male)
:race '(indian)
:badevents 0
:drugabuse 0
:medicalillness 1
:prescribemed 0
:familyhistory 0
:pasthistory 0
:birth 0
:socialwithdrawal 0
:depressedmood 1
:lossinterest 0
:weightloss 1
:insomnia 0
:psychomotorretard 0
:fatigue 0
:guilt 1
:indecisive 1
:suicide 1
:duration '(d2))
:solution
(make-solution :outcome '(You might have depression due to
other medical condition like thyroid diabetes cancer AIDS parkinson
disease )
:factor '(Major depression cannot be
diagnosed accurately as the symptoms are due to direct physiological
effects of a general medication Please consult your medical doctor for
a physical exam and further reference)
:criteria '(Symptoms for major depression
are not due to a general medical condition)
:period '(Symptoms occur at least every day
for at least two weeks)
:numberofsymptoms 5)
:result 's))
(defparameter *kes6*
(make-kes
:problem
(make-problem :age '(g5)
:gender '(female)
:race '(chinese)
:badevents 0
:drugabuse 0
:medicalillness 0
:prescribemed 1
:familyhistory 0
:pasthistory 0
:birth 0
:socialwithdrawal 0
:depressedmood 0
:lossinterest 1
:weightloss 1
:insomnia 1
:psychomotorretard 1
:fatigue 1
:guilt 0
:indecisive 0
:suicide 0
:duration '(d2))
:solution
(make-solution :outcome '(You might have depression due to
substance)
:factor '(Major depression cannot be
diagnosed accurately as the symptoms are due to direct physiological
effects of medication Please consult your medical doctor for a physical
exam and further reference )
:criteria '(Symptoms for major depression
are not due to substance abuse like medication or drug)
:period '(Symptoms occur at least every day
for at least two weeks)
:numberofsymptoms 5)
:result 's))
(defparameter *kes7*
(make-kes
:problem
(make-problem :age '(g5)
:gender '(female)
:race '(others)
:badevents 0
:drugabuse 0
:medicalillness 0
:prescribemed 0
:familyhistory 0
:pasthistory 1
:birth 0
:socialwithdrawal 0
:depressedmood 0
:lossinterest 1
:weightloss 0
:insomnia 0
:psychomotorretard 0
:fatigue 1
:guilt 1
:indecisive 1
:suicide 1
:duration '(d2))
:solution
(make-solution :outcome '(You have recurrent episode of
major depression)
:factor '(You have past episode of Please
seek your medical doctor for further assessment)
:criteria '(A person who has previous
episode of depression increases the risk of having another episode)
:period '(Symptoms occur at least every day
for at least two weeks)
:numberofsymptoms 5)
:result 's))
(defparameter *kes8*
(make-kes
:problem
(make-problem :age '(g2)
:gender '(male)
:race '(malay)
:badevents 0
:drugabuse 1
:medicalillness 0
:prescribemed 1
:familyhistory 0
:pasthistory 1
:birth 0
:socialwithdrawal 0
:depressedmood 1
:lossinterest 0
:weightloss 1
:insomnia 0
:psychomotorretard 1
:fatigue 1
:guilt 0
:indecisive 1
:suicide 0
:duration '(d2))
:solution
(make-solution :outcome '(You might be depressed due to
substance used)
:factor '(Major depression cannot be
diagnosed accurately as the symptoms are due to direct physiological
effects of substance used Please consult your medical doctor for a
physical exam and further reference)
:criteria '(Symptoms for major depression
are not due to substance abuse like medication or drug )
:period '(Symptoms occur at least every day
for at least two weeks)
:numberofsymptoms 5)
:result 's))
(defparameter *kes9*
(make-kes
:problem
(make-problem :age '(g2)
:gender '(female)
:race '(malay)
:badevents 1
:drugabuse 0
:medicalillness 0
:prescribemed 0
:familyhistory 0
:pasthistory 0
:birth 0
:socialwithdrawal 0
:depressedmood 0
:lossinterest 0
:weightloss 0
:insomnia 0
:psychomotorretard 1
:fatigue 1
:guilt 1
:indecisive 1
:suicide 1
:duration '(d2))
:solution
(make-solution :outcome '(You might be experiencing grief
or bereavement)
:factor '(Although you have more than 5
symptoms to show you have major depression but you have loss of events
recently)
:criteria '(Symptoms for major depression
are not accounted for bereavement)
:period '(Symptoms occur for more than 2
weeks)
:numberofsymptoms 5)
:result 's))
(defparameter *kes10*
(make-kes
:problem
(make-problem :age '(g1)
:gender '(male)
:race '(chinese)
:badevents 0
:drugabuse 0
:medicalillness 1
:prescribemed 1
:familyhistory 0
:pasthistory 0
:birth 0
:socialwithdrawal 0
:depressedmood 1
:lossinterest 0
:weightloss 1
:insomnia 0
:psychomotorretard 0
:fatigue 0
:guilt 1
:indecisive 1
:suicide 1
:duration '(d2))
:solution
(make-solution :outcome '(You are depressed due to other
general medical condition)
:factor '(Major depression cannot be
diagnosed accurately as the symptoms are due to direct physiological
effects of substance used Please consult your medical doctor for a
physical exam and further reference)
:criteria '(Symptoms for major depression
are not due to any general medical condition)
:period '(Symptoms occur for more than 2
weeks)
:numberofsymptoms 5)
:result 's))
(defparameter *kes-knowledgebase*
(list *kes1* *kes2* *kes3* *kes4* *kes5* *kes6* *kes7* *kes8* *kes9*
*kes10*))
(defun distance (current-problem kes-problem)
;"Returns the computed distance between the 2 problems."
(+ (* 1 (age-dist (problem-age current-problem) (problem-age
kes-problem)))
(* 2 (gender-dist (problem-gender current-problem) (problem-gender
kes-problem)))
(* 1 (race-dist (problem-race current-problem) (problem-race
kes-problem)))
(* 3 (loss-dist (problem-badevents current-problem)
(problem-badevents kes-problem)))
(* 5 (drug-dist (problem-drugabuse current-problem)
(problem-drugabuse kes-problem)))
(* 5 (medical-dist (problem-medicalillness current-problem)
(problem-medicalillness kes-problem)))
(* 5 (medication-dist (problem-prescribemed current-problem)
(problem-prescribemed kes-problem)))
(* 2 (family-dist (problem-familyhistory current-problem)
(problem-familyhistory kes-problem)))
(* 4 (past-dist (problem-pasthistory current-problem)
(problem-pasthistory kes-problem)))
(* 5 (birth-dist (problem-birth current-problem) (problem-birth
kes-problem)))
(* 2 (social-dist (problem-socialwithdrawal current-problem)
(problem-socialwithdrawal kes-problem)))
(* 9 (dep-dist (problem-depressedmood current-problem)
(problem-depressedmood kes-problem)))
(* 9 (interest-dist (problem-lossinterest current-problem)
(problem-lossinterest kes-problem)))
(* 6 (weight-dist (problem-weightloss current-problem)
(problem-weightloss kes-problem)))
(* 6 (insomnia-dist (problem-insomnia current-problem)
(problem-insomnia kes-problem)))
(* 6 (retard-dist (problem-psychomotorretard current-problem)
(problem-psychomotorretard kes-problem)))
(* 6 (fatigue-dist (problem-fatigue current-problem)
(problem-fatigue kes-problem)))
(* 6 (guilty-dist (problem-guilt current-problem) (problem-guilt
kes-problem)))
(* 6 (indecisive-dist (problem-indecisive current-problem)
(problem-indecisive kes-problem)))
(* 6 (suicide-dist (problem-suicide current-problem)
(problem-suicide kes-problem)))
(* 7 (duration-dist (problem-duration current-problem)
(problem-duration kes-problem)))))
;Returns the number of elements that occur in set newage.
(defun age-dist (newage oldage)
(length (set-difference newage oldage)))
;Returns the number of elements that occur in the set newgender.
(defun gender-dist (newgender oldgender)
(length (set-difference newgender oldgender)))
;Returns the number of elements that occurin the set newrace.
(defun race-dist (newrace oldrace)
(length (set-difference newrace oldrace)))
;Returns the numeric distance between newloss and oldloss.
(defun loss-dist (newloss oldloss)
(abs (- newloss oldloss)))
;Returns the numeric distance between newdrug and olddrug.
(defun drug-dist (newdrug olddrug)
(abs (- newdrug olddrug)))
;Returns the numeric distance between newsickness and oldsickness.
(defun sickness-dist (newsickness oldsickness)
(abs (- newsickness oldsickness)))
(defun medical-dist (newmedic oldmedic)
(abs (- newmedic oldmedic)))
(defun medication-dist (newmedication oldmedication)
(abs (- newmedication oldmedication)))
(defun family-dist (newfamily oldfamily)
(abs (- newfamily oldfamily)))
(defun past-dist(newpast oldpast)
(abs (- newpast oldpast)))
(defun birth-dist(newbirth oldbirth)
(abs (- newbirth oldbirth)))
(defun social-dist(newsocial oldsocial)
(abs (- newsocial oldsocial)))
(defun dep-dist(newdep olddep)
(abs (- newdep olddep)))
(defun interest-dist(newinterest oldinterest)
(abs (- newinterest oldinterest)))
(defun weight-dist(newweight oldweight)
(abs (- newweight oldweight)))
(defun insomnia-dist(newinsomnia oldinsomnia)
(abs (- newinsomnia oldinsomnia)))
(defun retard-dist(newretard oldretard)
(abs (- newretard oldretard)))
(defun fatigue-dist(newfatigue oldfatigue)
(abs (- newfatigue oldfatigue)))
(defun guilty-dist(newguilty oldguilty)
(abs (- newguilty oldguilty)))
(defun indecisive-dist(newindecisive oldindecisive)
(abs (- newindecisive oldindecisive)))
(defun suicide-dist(newsuicide oldsuicide)
(abs (- newsuicide oldsuicide)))
(defun duration-dist(newduration oldduration)
(length (set-difference newduration oldduration)))
(defun retrieve-examples (current-problem kes-knowledgebase)
;Returns a list of pairs of the form (DISTANCE KES),sorted in order
of lowest DISTANCE first.
(let((return-list nil))
(dolist (this-kes kes-knowledgebase return-list)
(setf return-list (insert-pair (distance current-problem
(kes-problem this-kes)) this-kes return-list)))))
(defun insert-pair (value kes the-list)
;Returns THE-LIST with the pair (VALUE KES) inserted in its place, so
that VALUES are increasing.
(cond ((null the-list) (list (list value kes)))
((< value (first (first the-list)))
(cons (list value kes) the-list))
(t (cons (first the-list)
(insert-pair value kes (rest the-list))))))
(defun report-failure (kes)
;Prints a message that kes adaptation is impossible.
(format t "~Unable to adapt example to current problem")
(format t "~%The partially adapted kes is :~%S" kes) kes)
(defun deep-copy-kes (kes)
;Copies a kes, including its problems and structures.
(make-kes
:problem (copy-problem (kes-problem kes))
:solution (copy-solution (kes-solution kes))
:result (kes-result kes)))
(defun fix-age (current-problem kes)
;Changes the age in retrieved example.
(let ((copy (deep-copy-kes kes)))
(setf (problem-age (kes-problem copy)) (problem-age
current-problem)) copy))
(defun fix-gender (current-problem kes)
;Changes the gender in retrieved example.
(let ((copy (deep-copy-kes kes)))
(setf (problem-gender (kes-problem copy)) (problem-gender
current-problem)) copy))
(defun fix-race (current-problem kes)
;Changes the race in retrieved example.
(let ((copy (deep-copy-kes kes)))
(setf (problem-race (kes-problem copy )) (problem-race
current-problem)) copy))
(defun fix-badevents (current-problem kes)
;Changes the bad events in retrieved example.
(let ((copy (deep-copy-kes kes)))
(setf (problem-badevents (kes-problem copy )) (problem-badevents
current-problem)) copy))
(defun fix-drugabuse (current-problem kes)
;Changes the drug abuse in retrieved example.
(let ((copy (deep-copy-kes kes)))
(setf (problem-drugabuse (kes-problem copy)) (problem-drugabuse
current-problem)) copy))
(defun fix-medicalillness (current-problem kes)
;Changes the medical illness in retrieved example.
(let ((copy (deep-copy-kes kes)))
(setf (problem-medicalillness (kes-problem copy))
(problem-medicalillness current-problem)) copy))
(defun fix-prescribemed (current-problem kes)
(let ((copy (deep-copy-kes kes)))
(setf (problem-prescribemed (kes-problem copy))
(problem-prescribemed current-problem)) copy))
(defun fix-familyhistory (current-problem kes)
(let ((copy (deep-copy-kes kes)))
(setf (problem-familyhistory (kes-problem copy))
(problem-familyhistory current-problem)) copy))
(defun fix-pasthistory (current-problem kes)
(let ((copy (deep-copy-kes kes)))
(setf (problem-pasthistory (kes-problem copy)) (problem-pasthistory
current-problem)) copy))
(defun fix-birth (current-problem kes)
(let ((copy (deep-copy-kes kes)))
(setf (problem-birth (kes-problem copy)) (problem-birth
current-problem)) copy))
(defun fix-socialwithdrawal (current-problem kes)
(let ((copy (deep-copy-kes kes)))
(setf (problem-socialwithdrawal (kes-problem copy))
(problem-socialwithdrawal current-problem)) copy))
(defun fix-depressedmood (current-problem kes)
(let ((copy (deep-copy-kes kes)))
(setf (problem-depressedmood (kes-problem copy))
(problem-depressedmood current-problem)) copy))
(defun fix-lossinterest (current-problem kes)
(let ((copy (deep-copy-kes kes)))
(setf (problem-lossinterest(kes-problem copy)) (problem-lossinterest
current-problem)) copy))
(defun fix-weightloss (current-problem kes)
(let ((copy (deep-copy-kes kes)))
(setf (problem-weightloss(kes-problem copy)) (problem-weightloss
current-problem)) copy))
(defun fix-insomnia (current-problem kes)
(let ((copy (deep-copy-kes kes)))
(setf (problem-insomnia(kes-problem copy)) (problem-insomnia
current-problem)) copy))
(defun fix-psychomotorretard (current-problem kes)
(let ((copy (deep-copy-kes kes)))
(setf (problem-psychomotorretard(kes-problem copy))
(problem-psychomotorretard current-problem)) copy))
(defun fix-fatigue (current-problem kes)
(let ((copy (deep-copy-kes kes)))
(setf (problem-fatigue(kes-problem copy)) (problem-fatigue
current-problem))copy))
(defun fix-guilt (current-problem kes)
(let ((copy (deep-copy-kes kes)))
(setf (problem-guilt(kes-problem copy)) (problem-guilt
current-problem))copy))
(defun fix-indecisive (current-problem kes)
(let ((copy (deep-copy-kes kes)))
(setf (problem-indecisive(kes-problem copy)) (problem-indecisive
current-problem))copy))
(defun fix-suicide (current-problem kes)
(let ((copy (deep-copy-kes kes)))
(setf (problem-suicide(kes-problem copy)) (problem-suicide
current-problem))copy))
(defun fix-duration (current-problem kes)
(let ((copy (deep-copy-kes kes)))
(setf (problem-duration(kes-problem copy)) (problem-duration
current-problem))copy))
(defun adapt-solution (current-problem trial-kes)
;Applies adaptation rules to try to transform the solution of the
selected trial kes into a solution for the current problem.
(let (temp) (and (setf temp (fix-age current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-gender current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-race current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-badevents current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-drugabuse current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-medicalillness current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-prescribemed current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-familyhistory current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-pasthistory current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-birth current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-socialwithdrawal current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-depressedmood current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-lossinterest current-problem trial-kes))
(Setf trial-kes temp)
(setf temp(fix-weightloss current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-insomnia current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-psychomotorretard current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-fatigue current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-guilt current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-indecisive current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-suicide current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-duration current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-solution current-problem trial-kes)))
(if (null temp) (report-failure trial-kes) temp)))
(defun fix-solution (current-problem kes)
(let ((copy (deep-copy-kes kes))
(current-outcome (solution-outcome (kes-solution kes)))
(current-factor (solution-factor (kes-solution kes)))
(current-criteria (solution-criteria (kes-solution kes)))
(current-period (solution-period (kes-solution kes)))
(current-numberofsymptoms(solution-numberofsymptoms (kes-solution
kes))))
(cond ((eql (problem-duration current-problem) '(d1))
(setf current-period '(The symptoms that you experienced are
less than two weeks)))
((eql (problem-duration current-problem) '(d2))
(setf current-period '(The symptoms that you experienced are
at least almost every day for two weeks))))
(cond ((eql (problem-badevents current-problem) 1) (setf
current-outcome '(You might be experiencing bereavement))
(setf current-factor '(You have recently got through a loss
of event))
(setf current-criteria '(Symptoms for major depression are
not accounted for bereavement))))
(cond ((eql (problem-drugabuse current-problem)1) (setf
current-outcome '(You might be depressed due to substance))
(setf current-factor '(You have drug or alcohol abuse or
medication as risk of depression))
(setf current-criteria '(Symptoms for major depression are
not due to substance))))
(cond ((eql (problem-prescribemed current-problem) 1) (setf
current-outcome '(You might be depressed due to substance))
(setf current-factor '(You have drug or alcohol abuse or
medication as risk of depression))
(setf current-criteria '(Symptoms for major depression are
not due to substance))))
(cond ((eql (problem-medicalillness current-problem) 1) (setf
current-outcome '(You might be depressed due to general medical
condition))
(setf current-factor '(You have other medical illness))
(setf current-criteria '(Symptoms for major depression are
not due to a general medical condition))))
(cond ((and (eql (problem-depressedmood current-problem) 0) (eql
(problem-lossinterest current-problem)0))
(setf current-outcome '(You do not have major depression))
(setf current-factor '(You have no mandatory symptoms))
(setf current-criteria '(Symptoms for major depression
include either depressed mood loss of interest or both))))
(cond ((and (eql (problem-depressedmood current-problem)1) (eql
(problem-lossinterest current-problem)1)
(eql (problem-badevents current-problem)0)
(eql (problem-drugabuse current-problem)0)
(eql (problem-prescribemed current-problem)0)
(eql (problem-medicalillness current-problem)0)
(eql (problem-duration current-problem) '(d2))
(> current-numberofsymptoms 5))
(setf current-outcome '(You have major depression))
(setf current-factor '(You have more than 5 symptoms
including the mandatory symptoms of major depression that is depressed
mood or loss interest))
(setf current-criteria '(Symptoms for major depression are
fulfilled))
(setf current-period '(The symptoms you experienced are
almost every day for two weeks))))
(cond ((and
(eql (problem-depressedmood current-problem)1)
(eql (problem-lossinterest current-problem)0)
(eql (problem-badevents current-problem)0)
(eql (problem-drugabuse current-problem)0)
(eql (problem-prescribemed current-problem)0)
(eql (problem-medicalillness current-problem)0)
(eql (problem-duration current-problem) '(d2))
(> current-numberofsymptoms 5))
(setf current-outcome '(You have major depression))
(setf current-factor '(You have more than 5 symptoms
including the mandatory symptoms of major depression that is depressed
mood or loss interest))
(setf current-criteria '(Symptoms for major depression are
fulfilled))
(setf current-period '(The symptoms you experienced are almost
every day for two weeks))))
(cond ((and (eql (problem-depressedmood current-problem)0)
(eql (problem-lossinterest current-problem)1)
(eql (problem-badevents current-problem)0)
(eql (problem-drugabuse current-problem)0)
(eql (problem-prescribemed current-problem)0)
(eql (problem-medicalillness current-problem)0)
(eql (problem-duration current-problem) ('d2))
(> current-numberofsymptoms 5))
(setf current-outcome '(You have major depression))
(setf current-factor '(You have more than 5 symptoms
including the mandatory symptoms of major depression that is depressed
mood or loss interest))
(setf current-criteria '(Symptoms for major depression are
fulfilled))
(setf current-period '(The symptoms you experienced are
almost every day for two weeks))))
; Now create a new kes with the modified solution
(setf (solution-outcome (kes-solution copy)) current-outcome)
(setf (solution-factor (kes-solution copy)) current-factor)
(setf (solution-criteria (kes-solution copy)) current-criteria)
(setf (solution-period (kes-solution copy)) current-period)
(setf (solution-numberofsymptoms(kes-solution copy))
current-numberofsymptoms)
(if (and current-outcome current-factor current-criteria
current-period current-numberofsymptoms) copy;
(report-failure copy))))
(defun solve (problem)
;Tries to solve the menu-planning PROBLEM, by retrieving matching
examples and modifying their solutions
(let ((matching-kes(retrieve-examples problem *kes-knowledgebase*))
(done nil)
(current-kes nil))
(loop
(if (or done (null matching-kes))
(return current-kes))
(setf current-kes (second (pop matching-kes)))
(if(setf current-kes (adapt-solution problem current-kes))
(setf done t))) current-kes))
;Prompts the user for menu problems and applies kes-based reasoning
to try to solve them
(defun cbr ()
(format t "~%Welcome to the kes-based menu planner!~%")
(let ((sample-problem (make-problem)) solution)
(loop (format t "~%What are are you? ")
(format t "~% Eg g1g2g3g4 :")
(setf (problem-age sample-problem) (read))
(format t "~%What gender are you?")
(setf (problem-gender sample-problem) (read))
(format t "~%What race are you?")
(setf (problem-race sample-problem) (read))
(format t "~%Any bad events lately?")
(setf (problem-badevents sample-problem) (read))
(format t "~%Do you drink often lately?")
(setf (problem-drugabuse sample-problem) (read))
(format t "~%Do you have any medical illness that you do?")
(setf (problem-medicalillness sample-problem) (read))
(format t "~%Do you have any precription of medicine that you do?")
(setf (problem-prescribemed sample-problem) (read))
(format t "~%Do you have any family who has history of depression?")
(setf (problem-familyhistory sample-problem) (read))
(format t "~%Do you have any past history of depression?")
(setf (problem-pasthistory sample-problem) (read))
(format t "~%Did you give birth before this?")
(setf (problem-birth sample-problem) (read))
(format t "~%Are you a social withdrawn person?")
(Setf (problem-socialwithdrawal sample-problem) (read))
(format t "~%Are you in depressed mood?")
(setf (problem-depressedmood sample-problem) (read))
(LET ( (x (problem-depressedmood sample-problem))))
(format t "~%Do you loss interest in almost everything normally you
do?")
(setf (problem-lossinterest sample-problem) (read))
(format t "~%Do you experience any weight loss or weight gain
recently?")
(setf (problem-weightloss sample-problem) (read))
(format t "~%Do you experience any difficulty in sleeping recently?")
(setf (problem-insomnia sample-problem) (read))
(format t "~%Do you experience any difficulty in doing simple things
recently?")
(setf (problem-psychomotorretard sample-problem) (read))
(format t "~%Do you feel easily fatigue recently?")
(setf (problem-fatigue sample-problem) (read))
(format t "~%Do you feel easily guilty recently?")
(setf (problem-guilt sample-problem) (read))
(format t "~%Do you feel hard to make decisions recently?")
(setf (problem-indecisive sample-problem) (read))
(format t "~%Do you any thoughs of suicide recently?")
(setf (problem-suicide sample-problem) (read))
(format t "~%How long have you been experiencing these symptoms?..d1 or
d2?")
(setf (problem-duration sample-problem) (read))
(format t "~%Searching in knowledgebase....~%")
;(setf contractedsymptoms ( + (problem-depressedmood sample-problem)
(problem-lossinterest sample-problem) (problem-weightloss
sample-problem) (problem-insomnia sample-problem)
(problem-psychomotorretard sample-problem) (problem-fatigue
sample-problem) (problem-guilt sample-problem) (problem-indecisive
sample-problem) (problem-suicide sample-problem)))
(setf solution (solve sample-problem))
(print-solution (kes-solution solution))
(savenew solution)
(append(list *kes11*)*kes-knowledgebase*)
(WITH-OPEN-FILE (f "newcase.txt" :DIRECTION :OUTPUT :IF-DOES-NOT-EXIST
:create :IF-EXISTS :append)
(FORMAT f "~%~S" *kes-knowledgebase*))
(format t "~%Another kes? Y or N...")
(if (eql (read) 'n) (return 'good-bye)))))
;Nicely formats the SOLUTION
(defun print-solution (solution)
(if solution (progn (format t "~%The outcome :~S."(solution-outcome
solution))
(format t "~% The factor:~S."(solution-factor
solution))
(format t "~% The criteria:~S."(solution-criteria
solution))
(format t "~% The period:~S."(solution-period
solution))
(format t "~% The number of symptoms are as much :
~S. ~%"(solution-numberofsymptoms solution)))
(format t "~%No acceptable soution is found.It is
saved into a file where it can be corrected by the expert system.
~%")))
(defun savenew (solution)
(defparameter *kes11* solution))
·········@yahoo.com wrote:
> To anyone, please do help me before viva next week. Still have problems
> with the updating to the knowledge base.
Your code is quite hard to read, and I can't say I've managed to grasp
it all. I'm going to make a couple of general suggestions that
hopefully help in spite of that.
> 1.in savenew function as below : solution is the adapted case which has
> been obtained after the matching process. The question is how do I make
> the parameter name change,e.g * kes11*the next *kes12* and so on? by
> using dotimes and a variable *kes (i)* and increment i+1 ?
You can create a numbered set of variable names like this:
(dotimes (i 5)
(intern (format nil "*KES~d*" i)))
I don't think this is a very good way to do it, though. Do you really
need to name the solutions? If not, updating the knowledgebase is just
(push solution *kes-knowledgebase*)
If you output this with
(format f "~&~S" *kes-knowledgebase*)
the kbase can easily be read back in with READ.
If you do need to name the solutions, a hash table with strings for
keys seems to be the most elegant solution. However, you need to write
your own print/read functions, so you might not want to do that.
Instead, you could use an association list (alist) along these lines:
(defparameter *keynum* 0)
(defun keyname ()
(format nil "Kes~D" (incf *keynum*)))
(defun savenew (solution)
(acons (keyname) solution *kes-knowledgebase*))
(defun solve (problem)
(find problem
(applicable-part-of *kes-knowledgebase*)
:test #'match-solution-to-problem)
I am guessing that applicable-part-of and match-solution-to-problem
correspond to RETRIEVE-EXAMPLES and ADAPT-SOLUTION in your code.
(I usually don't post untested code, but there was no way for me to
test this without spending more time than I have with your code.)
> (append(list *kes11*)*kes-knowledgebase*)
This creates a list that has value of *kes11* as first element, and the
elements of *kes-knowledgebase* as the rest of its elements. This list
is then immediately thrown away.
If you want to create a list that is a copy of *kes-knowledgebase* with
the value of *kes11* appended to it, you need to write
(setf newlist (append *kes-knowledgebase* (list *kes11*)))
but you shouldn't do that either. If order is important, use a vector.
If not, simply PUSH the new solution on the kbase.
> (WITH-OPEN-FILE (f "newcase.txt" :DIRECTION :OUTPUT :IF-DOES-NOT-EXIST
> :create :IF-EXISTS :append)
> (FORMAT f "~%~S" *kes-knowledgebase*))
There is a problem here. The :IF-EXISTS :append part means that the
old contents of the file will never be thrown away, so you will have a
lot of redundant data in it.
Either 1) append to the kbase in the program and save it to file with
:IF-EXISTS :supersede, or 2) append the new solution to the file using
:IF-EXISTS :append and then update the kbase by reading it back. My
suggestion is 1).
> 3. Say if I want to add a new slot-name under the structure of problem,
> how do i do that?
Do it in the source file. You won't necessarily need to update the
constructors of the existing solutions even if you add a new slot.
Consider using default values: if you define the problem structure as
(defstruct problem
age
gender
race
(badevents 0)
(drugabuse 0)
(medicalillness 0)
(prescribemed 0)
(familyhistory 0)
(pasthistory 0)
(birth 0)
(socialwithdrawal 0)
(depressedmood 0)
(lossinterest 0)
(weightloss 0)
(insomnia 0)
(psychomotorretard 0)
(fatigue 0)
(guilt 0)
(indecisive 0)
(suicide 0)
(duration '(d2)))
then the problem part of *kes2* can be constructed as follows:
(make-problem :age '(g3)
:gender '(male)
:race '(indian)
:badevents 1
:psychomotorretard 1
:fatigue 1
:guilt 1
:indecisive 1)
and if you later add a new slot (shoestosmall 0) only cases where this
is a factor need to initialize that slot.
HTH
1. If a new factor or symptom is to be updated , that means a new slot
or criteria has to be added in the original/existing structure plus the
new structure to store the new structure too, how exactly can I do
that?
2. Can the syntax for classes be used for structures - like slot-boundp
and so on?
3. Do I only have a choice to actually use the printed method available
for structures? How do I print out the new solution by assigning to the
value of an text a form/ide? Have tried to use (format '~d solution')
but not achievable, the value in the text of the form does not display
in the editable-text in the form?
cheeryast wrote:
> 1. If a new factor or symptom is to be updated , that means a new slot
Edit the DEFSTRUCT form and recompile.
> 2. Can the syntax for classes be used for structures - like slot-boundp
> and so on?
It depends. SLOT-BOUNDP will work, but AFAICT it won't be all that
useful unless you're actually using CLOS objects. My advice is to
convert the structures into classes if you feel the least inclined to
use CLOSish syntax.
> 3. Do I only have a choice to actually use the printed method available
> for structures?
No, you can specialize PRINT-OBJECT on your structure class designator.
> How do I print out the new solution by assigning to the
> value of an text a form/ide?
Obviously, that depends on your IDE API.
From: Frank Buss
Subject: Re: Plz HELP check codes before Viva next week!!!Your ideas are much appreciated...!
Date:
Message-ID: <19cv2pfpcehol.ylt391rz4pqe.dlg@40tude.net>
·········@yahoo.com wrote:
> Well, my expert system code is as such; there are a few functions in
> the top-level cbr function( bottomest coding) that cannot work and
> incomplete of purpose.
you mean this is part of your task, to make it complete and to fix the loop
abort bug in the code and the quote bug? Did you wrote this program? If
not, complain to your teacher, because this code only pretends to be Common
Lisp, it is really more like a bad programmed C program.
> 1.in savenew function as below : solution is the adapted case which has
> been obtained after the matching process. The question is how do I make
> the parameter name change,e.g * kes11*the next *kes12* and so on? by
> using dotimes and a variable *kes (i)* and increment i+1 ?
you have fundamental problems with Lisp. Try push.
> 2.The append function seem not to be working as I do not see the
> appended solution being append to the existing knowledge base in
> newcase.txt . How do I append the newly adapted solution with the
> parameter *kes11* *kes12* to existing *kes-knowledgebase* which
> already comprise the list of *kes1* *kes2*......*kes10* ?
same answer as before. Alternative: try to read and understand the
explanation of "append", for example:
http://www.lispworks.com/documentation/HyperSpec/Body/f_append.htm
http://www.gigamonkeys.com/book/they-called-it-lisp-for-a-reason-list-processing.html
> 3. Say if I want to add a new slot-name under the structure of problem,
> how do i do that?
if you've written or at least if you've understand the program, this should
be trivial.
--
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
From: Joe Marshall
Subject: Re: Plz HELP check codes before Viva next week!!!Your ideas are much appreciated...!
Date:
Message-ID: <3bn8ykpb.fsf@alum.mit.edu>
·········@yahoo.com writes:
> To anyone, please do help me before viva next week. Still have problems
> with the updating to the knowledge base.
I hate to be the bearer of bad news, but you have your work cut out
for you. I can point out some errors, but I'm not sure that things
can be reworked by next week.
> In brief, this expert system diagnose a sickness and that
>
> 1.in savenew function as below : solution is the adapted case which has
> been obtained after the matching process. The question is how do I make
> the parameter name change,e.g * kes11*the next *kes12* and so on? by
> using dotimes and a variable *kes (i)* and increment i+1 ?
>
>
> (defun savenew (solution)
> (defparameter *kes11* solution))
This cannot hope to work. You can't dynamically add variables to your
program without using some form of reflection. You *shouldn't*
dynamically add variables to your program unless you are implementing
a programming language.
What you ought to do is keep a list of solutions. If you need to
refer to them by name, make a table of solutions.
(defparameter *all-solutions* '())
(defun save-solution (solution)
(push solution *all-solutions*))
> 2.The append function seem not to be working as I do not see the
> appended solution being append to the existing knowledge base in
> newcase.txt . How do I append the newly adapted solution with the
> parameter *kes11* *kes12* to existing *kes-knowledgebase* which
> already comprise the list of *kes1* *kes2*......*kes10* ?
>
> (append (list *kes11*)*kes-knowledgebase*)
APPEND works, but it doesn't modify anything, it simply creates a new
list. If you don't use the return value, it is garbage collected.
By the way, if you are simply prepending a single element, you want CONS:
(cons *kes11* *kes-knowledgebase*)
rather than APPEND
(append (list *kes11*) *kes-knowledgebase*)
> (WITH-OPEN-FILE (f "newcase.txt" :DIRECTION :OUTPUT :IF-DOES-NOT-EXIST
> :create :IF-EXISTS :append)
> (FORMAT f "~%~S" *kes-knowledgebase*))
Once you have the solutions in a list, this will write that list to a
file, but since you are appending to the file each time, the file will
get duplicates. After the fifth solution, for example, the file will
look like this:
solution1 | written for first solution
solution2 | two entries written on second solution
solution1
solution3 | three entries written on third solution
solution2
solution1
solution4 | four entries written on fourth solution
solution3
solution2
solution1
solution5 | five entries written on fifth solution
solution4
solution3
solution2
solution1
> 3. Say if I want to add a new slot-name under the structure of problem,
> how do i do that?
This is a serious problem. In a `real' database, this is called a
`schema change' and it is not trivial to get it right (old problems
won't have the slot, so you have to go through and back-patch existing
data structures).
I suggest that instead of having a problem be a flat structure that
you have it use an association list that maps slot-names to values.
> 4. Full example code as below . Please reply asap anyone. Thank you.
>
;;; -*-Lisp-*-
;;;
;;; ALWAYS start with an in-package form.
(in-package "KES")
;;; Always indent your code properly.
;;; Use a blank line between top-level forms.
(defstruct kes
problem
solution
result)
;;; It is always a good idea to specify the type of a field *if* you
;;; know what it is.
(defstruct problem
age
gender
race
duration
;; These items are boolean (either true or false).
;; Rather than having a problem contain all these fields,
;; make a single field and symbolically name them.
;; Use hyphens to separate words in long identifiers
bad-events
drug-abuse
medical-illness
prescribe-med
family-history
past-history
birth
social-withdrawal
depressed-mood
loss-interest
weight-loss
insomnia
psychomotor-retard
fatigue
guilt
indecisive
suicide)
(defstruct solution
outcome
factor
criteria
period
numberofsymptoms
result)
(defparameter *kes-knowledgebase*
(list
;; Problem 1
(make-kes
:problem
; Why are these lists?
(make-problem :age '(g3) ; Use keyword values :g3
:gender '(male) ; :male
:race '(chinese) ; :chinese
:duration '(d1) ; :d1
;; Give the fields a default value so you only have to specify
;; the true ones.
:badevents 0
:drugabuse 0
:medicalillness 0
:prescribemed 0
:familyhistory 0
:pasthistory 0
:birth 0
:socialwithdrawal 0
:depressedmood 0
:lossinterest 0
:weightloss 1
:insomnia 1
:psychomotorretard 1
:fatigue 1
:guilt 1
:indecisive 1
:suicide 0
)
:solution
(make-solution
;; DON'T USE LISTS LIKE THIS. This went out of style in the 70s.
;; Use a string.
:outcome '(You have no major depression)
:factor '(This is because you have neither
depressed mood nor loss of interest)
:criteria '(You must have at least 1
mandatory symptom)
:period '(Symptoms have to be almost every
day for at least 2 weeks)
:numberofsymptoms 7)
:result 's)
;;; Problems 2-9 omitted
(make-kes
:problem
(make-problem :age '(g1)
:gender '(male)
:race '(chinese)
:badevents 0
:drugabuse 0
:medicalillness 1
:prescribemed 1
:familyhistory 0
:pasthistory 0
:birth 0
:socialwithdrawal 0
:depressedmood 1
:lossinterest 0
:weightloss 1
:insomnia 0
:psychomotorretard 0
:fatigue 0
:guilt 1
:indecisive 1
:suicide 1
:duration '(d2))
:solution
(make-solution :outcome '(You are depressed due to other
general medical condition)
:factor '(Major depression cannot be
diagnosed accurately as the symptoms are due to direct physiological
effects of substance used Please consult your medical doctor for a
physical exam and further reference)
:criteria '(Symptoms for major depression
are not due to any general medical condition)
:period '(Symptoms occur for more than 2
weeks)
:numberofsymptoms 5)
:result 's)))
;;; This is a kludge. You really want a first-class notion of a
;;; weighted property.
(defun distance (current-problem kes-problem)
"Returns the computed distance between the 2 problems."
;; Much clearer with a local macro.
(macrolet ((weighted-field (weight field)
;; Don't do this unless you *know* what it does.
(flet ((symbol-append (&rest syms)
(intern (format nil "~a"
(apply #'concatenate 'string
(map 'list #'symbol-name syms)))
(find-package "KES"))))
`(* ,weight (,(symbol-append field '-dist)
(,(symbol-append problem- field) current-problem)
(,(symbol-append problem- field) kes-problem))))))
(* (weighted-field 1 age)
(weighted-field 2 gender)
(weighted-field 1 race)
(weighted-field 3 bad-events)
(weighted-field 5 drug-abuse)
(weighted-field 5 medical-illness)
(weighted-field 5 prescribe-med)
(weighted-field 2 family-history)
(weighted-field 4 past-history)
(weighted-field 5 birth)
(weighted-field 2 social-withdrawal)
(weighted-field 9 depressed-mood)
(weighted-field 9 loss-interest)
(weighted-field 6 weight-loss)
(weighted-field 6 insomnia)
(weighted-field 6 psychomotor-retard)
(weighted-field 6 fatigue)
(weighted-field 6 guilty)
(weighted-field 6 indecisive)
(weighted-field 6 suicide)
(weighted-field 7 duration))))
(defun age-dist (newage oldage)
;; Don't put documentation in comments, use the docstring.
"Returns the number of elements that occur in set newage."
(length (set-difference newage oldage)))
;;; More `dist' functions elided.
;;; BE CONSISTENT WITH NAMING. Everywhere else, this is referred to
;;; as `bad-events', not `loss'.
;(defun loss-dist (newloss oldloss)
; "Returns the numeric distance between newloss and oldloss."
; (abs (- newloss oldloss)))
(defun bad-events-dist (newloss oldloss)
"Returns the numeric distance between newloss and oldloss."
(abs (- newloss oldloss)))
;;; More `dist' functions elided.
;; If you are sorting some results, use SORT, don't write your own.
;(defun retrieve-examples (current-problem kes-knowledgebase)
; "Returns a list of pairs of the form (DISTANCE KES), sorted in order of lowest DISTANCE first."
; (let ((return-list nil))
; (dolist (this-kes kes-knowledgebase return-list)
; (setf return-list (insert-pair (distance current-problem (kes-problem this-kes))
; this-kes
; return-list)))))
(defun retrieve-examples (current-problem knowledgebase)
"Returns a list of pairs of the form (DISTANCE KES), sorted in order of lowest DISTANCE first."
(sort (map 'list (lambda (kes)
(list (distance current-problem (kes-problem kes))
kes))
knowledgebase)
#'<
:key #'car))
(defun report-failure (kes)
"Prints a message that kes adaptation is impossible."
(format t "~Unable to adapt example to current problem")
(format t "~%The partially adapted kes is :~%S" kes)
kes)
;; KES objects shouldn't need to be deep copied.
;; Rethink your data structures.
(defun deep-copy-kes (kes)
"Copies a kes, including its problems and structures."
(make-kes
:problem (copy-problem (kes-problem kes))
:solution (copy-solution (kes-solution kes))
:result (kes-result kes)))
;;; There has got to be a better solution here.
(defun fix-age (current-problem kes)
"Changes the age in retrieved example."
(let ((copy (deep-copy-kes kes)))
(setf (problem-age (kes-problem copy))
(problem-age current-problem))
copy))
;;; Other `fix' routines elided.
(defun adapt-solution (current-problem trial-kes)
"Applies adaptation rules to try to transform the solution of the
selected trial kes into a solution for the current problem."
(let (temp)
;; This is terrible! Each `fix' routine makes a deep copy of the trial
;; object, so you end up copying it some 20-odd times!
(and (setf temp (fix-age current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-gender current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-race current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-badevents current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-drugabuse current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-medicalillness current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-prescribemed current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-familyhistory current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-pasthistory current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-birth current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-socialwithdrawal current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-depressedmood current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-lossinterest current-problem trial-kes))
(Setf trial-kes temp)
(setf temp(fix-weightloss current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-insomnia current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-psychomotorretard current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-fatigue current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-guilt current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-indecisive current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-suicide current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-duration current-problem trial-kes))
(setf trial-kes temp)
(setf temp(fix-solution current-problem trial-kes)))
(if (null temp) (report-failure trial-kes) temp)))
(defun fix-solution (current-problem kes)
(let ((copy (deep-copy-kes kes))
(current-outcome (solution-outcome (kes-solution kes)))
(current-factor (solution-factor (kes-solution kes)))
(current-criteria (solution-criteria (kes-solution kes)))
(current-period (solution-period (kes-solution kes)))
(current-numberofsymptoms (solution-numberofsymptoms (kes-solution kes))))
;; This won't work. The literal list '(d1) here may or may not be
;; eql to the list '(d1) in any of the solutions.
(cond ((eql (problem-duration current-problem) '(d1))
(setf current-period '(The symptoms that you experienced are
less than two weeks)))
((eql (problem-duration current-problem) '(d2))
(setf current-period '(The symptoms that you experienced are
at least almost every day for two weeks))))
;; Use WHEN
(when (eql (problem-badevents current-problem) 1)
;; Use multiple arguments to SETF.
(setf current-outcome '(You might be experiencing bereavement)
current-factor '(You have recently got through a loss of event)
current-criteria '(Symptoms for major depression are
not accounted for bereavement)))
;; Other cond statements omitted.
;; Now create a new kes with the modified solution
(setf (solution-outcome (kes-solution copy)) current-outcome)
(setf (solution-factor (kes-solution copy)) current-factor)
(setf (solution-criteria (kes-solution copy)) current-criteria)
(setf (solution-period (kes-solution copy)) current-period)
(setf (solution-numberofsymptoms (kes-solution copy))
current-numberofsymptoms)
(if (and current-outcome current-factor current-criteria
current-period current-numberofsymptoms)
copy ;
(report-failure copy))))
(defun solve (problem)
"Tries to solve the menu-planning PROBLEM, by retrieving matching
examples and modifying their solutions"
(let ((matching-kes (retrieve-examples problem *kes-knowledgebase*))
(done nil)
(current-kes nil))
;; This loop is a mess.
;; What are you trying to accomplish?
(loop
(if (or done (null matching-kes))
(return current-kes))
(setf current-kes (second (pop matching-kes)))
(if (setf current-kes (adapt-solution problem current-kes))
(setf done t)))
current-kes))
;;; User interface omitted.