project.clp

NASA 开发使用的一个专家系统

;*****************************************************************************
;*                                                                           *
;*                            WARNING and DISCLAIMER                         *
;*                                                                           *
;* This implementation the National Cholesterol Education Program guidelines *
;* in CLIPS is intended purely for educational purposes.  It was not         *
;* intended for actual use in a clinical setting.  Rigorous evaluation and   *
;* validation has NOT been done.  It is released to the public with          *
;* absolutely no warranty whatsoever regarding either the correctness of     *
;* the program, or its suitability for any purpose, whatsoever. The user     *
;* assumes all risks and liabilities from the use of this program.           *
;*                                                                           *
;* This program is neither supported nor maintained at this time.  Work on   *
;* the program ended in May 1994.  The program has not been updated since    *
;* that time.                                                                *
;*                                                                           *
;*****************************************************************************
;
; Brief description of the design of the program:
; The program uses various states (boxes in Fig. 1, 2, and 3 of the
; attached paper). State "aa" is the default beginning state. Most
; of the rules are dependent on the current state.
; There are rules for checking missing cholesterol, hdl, and ldl
; values. These rules DO NOT update state because they are dependent
; on the hdl, chol, and ldl values. As soon as the values are
; modified. Other rules (from state to state) will fire.

; patient1 tempate is for orginal patient information
(deftemplate patient1
	(slot name (type SYMBOL) (default ?DERIVE))
	(slot sex (type SYMBOL) (allowed-symbols female male) (default female))
	(slot h-chd (type SYMBOL) (allowed-symbols yes no) (default no))
	(slot htn (type SYMBOL) (allowed-symbols yes no) (default no))
	(slot smoking (type SYMBOL) (allowed-symbols yes no) (default no))
	(slot dm (type SYMBOL) (allowed-symbols yes no) (default no))
	(slot chd (type SYMBOL) (allowed-symbols yes no) (default no))
	(slot et (type SYMBOL) (allowed-symbols yes no) (default no))
	(slot pm (type SYMBOL) (allowed-symbols yes no) (default no))
	(slot age (type INTEGER) (default ?DERIVE)) 
	(slot hdl (type INTEGER) (default -1))
	(slot hdl-date (type INTEGER) (default (get-now)))	
	(slot ldl (type INTEGER) (default -1))
	(slot ldl-date (type INTEGER) (default (get-now)))
	(slot chol (type INTEGER) (default -1))
	(slot chol-date (type INTEGER) (default (get-now)))
	(slot treatment (type SYMBOL) 
		(allowed-symbols none diet drug) (default none))
	(slot treatment-date (type INTEGER) (default (get-now))))

; patient2 tempate is for processed patient information using 
; data form patient1
(deftemplate patient2
	(slot name (type SYMBOL) (default ?DERIVE))
	(slot chd (type SYMBOL) (allowed-symbols yes no) (default no))
	(slot hdl (type INTEGER) (default -1))
	(slot hdl-date (type INTEGER) (default (get-now)))	
	(slot ldl (type INTEGER) (default -1))
	(slot ldl-date (type INTEGER) (default (get-now)))
	(slot chol (type INTEGER) (default -1))
	(slot chol-date (type INTEGER) (default (get-now)))
	(slot treatment (type SYMBOL) 
		(allowed-symbols none diet drug) (default none))
	(slot treatment-date (type INTEGER) (default (get-now)))
	(slot risk (type INTEGER) (default ?DERIVE))
	(slot state (type SYMBOL) (default aa))
	(slot done (type SYMBOL) (allowed-symbols yes no) (default no)))

;*********BEGINNING OF RISK FACTOR RELATED FUNCTIONS*********
; Return 1 if argument is yes, 0 otherwise
(deffunction r1 (?a) "Return 1 if ?a = yes, 0 otherwise"
  (if (= 0 (str-compare ?a yes)) then (return 1)
   else (return 0)))

; function for sex and age related risk
(deffunction sex-risk (?s ?a ?pm ?et) "sex & age related risk"
  (if (= 0 (str-compare ?s male)) 
     then (if (>= ?a 45) 
	     then (return 1) 
	   else (return 0))
   else (if (>= ?a 65) 
	   then (return 1)
	 else (if (= 0 (str-compare ?pm yes)) 
		 then (if (= 0 (str-compare ?et yes))
			 then (return 1)
                       else (return 0))
	       else then (return 0)))))

; function to calculate hdl related risk
(deffunction hdl-risk (?hdl) "hdl risk"
  (if (< ?hdl 35) then (return 1) 
   else (if (>= ?hdl 60) then (return -1) else (return 0))))

; function for risk factors from the following:
; smoking, hypertension, diabetes, history of chd
(deffunction other-risk (?smoke ?h-chd ?htn ?dm) 
  (return (+ (r1 ?smoke) (r1 ?h-chd) (r1 ?htn) (r1 ?dm))))

; all risk factors
(deffunction total-risk (?sex ?age ?pm ?et ?hdl ?smoke ?h-chd ?htn ?dm) 
  (return (+ (sex-risk ?sex ?age ?pm ?et) (hdl-risk ?hdl)
	     (other-risk ?smoke ?h-chd ?htn ?dm))))
;*********END OF RISK FACTOR RELATED FUNCTIONS*********

; create new patient template with risk factors
(defrule create-patient2 "create patient2 based on info from patient1"
  (patient1 (sex ?sex) (age ?age) (pm ?pm) (et ?et) (smoking ?sm)
	    (h-chd ?h-chd) (htn ?htn) (dm ?dm)
            (name ?name) (chd ?chd) (hdl ?hdl) (ldl ?ldl) (chol ?chol)
	    (hdl-date ?hdl-date)  (ldl-date ?ldl-date)(chol-date ?chol-date) 
	    (treatment ?treatment) (treatment-date ?treatment_date))
  =>
  (assert (patient2 (name ?name) (chd ?chd) (hdl ?hdl) (ldl ?ldl) (chol ?chol)
	    (hdl-date ?hdl-date)  (ldl-date ?ldl-date)(chol-date ?chol-date) 
	    (treatment ?treatment) (treatment-date ?treatment_date)
	    (risk (total-risk ?sex ?age ?pm ?et ?hdl ?sm ?h-chd ?htn ?dm)))))

;****************************************************************************
;**************START OF RULES FOR UNTREATED PATIENTS WITHOUT CHD ************
;****************************************************************************


; Every patient must have cholesterol test. Does not modify state
(defrule check-chol "Check for presence of cholesterol"
  ?f1 <- (patient2 (name ?name) (chol ?chol) 
		   (treatment ?treatment) (done ?done))
  (test (= ?chol -1))
  (test (= 0 (str-compare ?done no)))
  (test (= 0 (str-compare ?treatment none)))
  =>
  (printout t crlf "Please input patient's " ?name "'s cholesterol value ")
  (printout t "[-1 if no value]" crlf)
  (bind ?answer (read))
  (if (and (numberp ?answer) (> ?answer 0)) then
	  (modify ?f1 (chol ?answer))
   else
	(printout t "Please obtain cholesterol test on " ?name crlf)
	  (modify ?f1 (done yes))))
;!!!no need to modify done here since default staet is aa. It goes nowhere.
; LOOK AT NEXT RULE

; rule for checking the age of the chol value
(defrule check-chol-date "date must be within 5 years"
  ?f1 <- (patient2 (name ?name) (chol-date ?chol-date) 
		   (treatment ?treatment) (done ?done))
  (test (five-years ?chol-date))
  (test (= 0 (str-compare ?done no)))
  (test (= 0 (str-compare ?treatment none)))
=>
  (printout t crlf)
  (printout t "The last cholesterol value for " ?name 
	    " is over 5 years old." crlf)
  (printout t "-------------------------------------------------------"crlf)
  (printout t "|  Please check cholesterol value.                    |" crlf)
  (printout t "-------------------------------------------------------"crlf)
  (modify ?f1 (done yes)))

; rule for box A. All patients without chd  goes to box A
(defrule ruleA "getting to box A"
  ?f1 <- (patient2 (chd ?chd) (done ?done) 
		   (treatment ?treatment) (state ?state))
  (test (= 0 (str-compare ?chd no)))
  (test (= 0 (str-compare ?done no)))
  (test (= 0 (str-compare ?state aa))) ; state
  (test (= 0 (str-compare ?treatment none)))
  =>
  (modify ?f1 (state a)))

; rule for A->B
(defrule A2B "getting to box A"
  ?f1 <- (patient2 (chol ?chol) (done ?done) (state ?state))
  (test (= 0 (str-compare ?done no)))
  (test (= 0 (str-compare ?state a)))
  (test (< ?chol 200))
  =>
  (modify ?f1 (state b)))

; rule for A->C
(defrule A2C "getting to box C"
  ?f1 <- (patient2 (chol ?chol) (done ?done) (state ?state))
  (test (= 0 (str-compare ?done no)))
  (test (= 0 (str-compare ?state a)))
  (test (<= ?chol 239))
  (test (>= ?chol 200))
  =>
  (modify ?f1 (state c)))

; rule for A->D
(defrule A2D "getting to box D"
  ?f1 <- (patient2 (chol ?chol) (done ?done) (state ?state))
  (test (= 0 (str-compare ?done no)))
  (test (= 0 (str-compare ?state a)))
  (test (>= ?chol 240))
  =>
  (modify ?f1 (state d)))

; rule to check for hdl at box B
(defrule check-hdl-at-B
  ?f1 <- (patient2 (name ?name) (done ?done) (state ?state) (hdl ?hdl))
  (test (= 0 (str-compare ?done no)))
  (test (= 0 (str-compare ?state b)))
  (test (= ?hdl -1))
  =>
  (printout t crlf)
  (printout t crlf 
       "Please input patient " ?name "'s hdl value [-1 if no value]" crlf)
  (bind ?answer (read))
  (if (and (numberp ?answer) (> ?answer 0)) then
	  (modify ?f1 (hdl ?answer)) 
   else
       (printout t crlf
		 "-------------------------------------------------------"crlf)
       (printout t "Please obtain hdl test on " ?name crlf)
       (printout t 
		 "-------------------------------------------------------"crlf)
       (modify ?f1 (done yes))))

; rule to check for hdl at box C
(defrule check-hdl-at-C
  ?f1 <- (patient2 (name ?name) (done ?done) (state ?state) (hdl ?hdl))
  (test (= 0 (str-compare ?done no)))
  (test (= 0 (str-compare ?state c)))
  (test (= ?hdl -1))
  =>
  (printout t crlf)
  (printout t 
     "Please input patient " ?name "'s hdl value [-1 if no value]" crlf)
  (bind ?answer (read))
  (if (and (numberp ?answer) (> ?answer 0)) then
	  (modify ?f1 (hdl ?answer))
   else
       (printout t crlf
		 "-------------------------------------------------------"crlf)
       (printout t "Please obtain hdl test on " ?name crlf)
       (printout t 
		 "-------------------------------------------------------"crlf)
       (modify ?f1 (done yes))))

; rule to check the age of the hdl value
(defrule check-hdl-date "date must be within 5 years"
  ?f1 <- (patient2 (name ?name) (hdl-date ?hdl-date) 
		   (done ?done) (state ?state))
  (test (five-years ?hdl-date))
  (test (= 0 (str-compare ?done no)))
=>
  (printout t crlf
		 "-------------------------------------------------------"crlf)
  (printout t "|  The last hdl value for " ?name 
	    " is over 5 years old." crlf)
  (printout t "|  Please check hdl value on " ?name crlf)
  (printout t "-------------------------------------------------------"crlf)
  (modify ?f1 (done yes)))



; rule for box I, see the paper 
; (NAMA, Juen 16, 1993-Vol 269, No. 23, pp 3015-3023)
(defrule B2E2I "Rule for box I"
  ?f1 <- (patient2 (name ?name)
	    (done ?done)
	    (state ?state)
	    (hdl ?hdl))
  (test (= 0 (str-compare ?done no)))
  (test (= 0 (str-compare ?state b)))
  (test (>= ?hdl 35))
  =>
  (printout t crlf "Patient " ?name " needs the following treatement:"crlf)
  (printout t "-------------------------------------------------------"crlf)
  (printout t "| 1. Repeat Total Cholesterol and HDL Cholesterol     |"crlf)
  (printout t "|    Measurement Within 5 Years or With Physical      |"crlf)
  (printout t "|    Education.                                       |"crlf)
  (printout t "| 2. Provide Education on Genral Population Eating    |"crlf)
  (printout t "|    Pattern, Physical Activity, and Risk Factor      |"crlf)
  (printout t "|    Reduction.                                       |"crlf)
  (printout t "-------------------------------------------------------"crlf)
  (modify ?f1 (done yes) (state i)))

; rule going from box B->F->K