;use inner&outer bound, then maybe rsm-fuzzy
(in-package "LISA-USER")
(lisa:consider-taxonomy)
;pull out a defclass macro to save time
 ;try to get as many DL like constraints in as possible
   ;look @nokia &swclos &cl-semantic work

;at least get acache defclass* in here (but doesn't lisa also have a metaclass?)
;utils::Define-Class trail-base () )
(defclass trail-base () ())
;(utils::Define-Class patient (trial-base) id)
(defclass patient (trial-base) (id))
;(utils::Define-Class newborn (patient) 
;  fullterm-p apgar blood-gas encephalopathy-p)
;defclass newborn (patient)
;defclass newborn (trial-base)
(defclass newborn ()
  ((fullterm-p :initarg :fullterm-p
             :initform 'na)
   (gestAge :initarg :gestAge
              :initform nil)
    (apgar :initarg :apgar
              :initform nil)
    (bd :initarg :bd ;alt for apgar in this miniExmpl
              :initform nil)
   (blood-gas :initarg :blood-gas
              :initform nil)
   (encephalopathy-p :initarg :encephalopathy-p
            :initform 'na)))
(watch :activations)
(watch :facts)
(watch :rules)

(defrule startup ()
  =>
  (assert
   ((make-instance 'newborn 
	 :gestAge 9
	 ;:fullterm-p t
	  :apgar 5
	  :blood-gas 7
	  :encephalopathy-p 't)))
  (assert
   ((make-instance 'newborn 
	 :gestAge 9
	 ;:fullterm-p t
	 ;:apgar 5
	 :bd 16
	  :blood-gas 7
	  :encephalopathy-p 't)))
  (assert
   ((make-instance 'newborn 
	 :gestAge 9
	 ;:fullterm-p t
	  :apgar 5
	  :blood-gas 8
	  :encephalopathy-p 't)))
  (assert
   ((make-instance 'newborn 
	 :gestAge 9
	 ;:fullterm-p t
	  :apgar 5
	  :blood-gas 9
	  :encephalopathy-p 't)))
  ) 
;consider 'measurment' instances, which can be viewed many ways(contextually?)incl symbolic rating* 
;-mix fwd&bw to find things (agraph/screamer/prolog kn-works)ocelot/loom/etc
;(defrule fullterm ()
; "set fullterm-p slot" ;could do w/an init-inst:after
; (?baby (newborn 
;	  (gestAge 9)))
;  =>
;   (modify ?baby
;	  (fullterm-p t))) ;better for 1shot inits:
(defmethod initialize-instance :after ((Obj newborn) &rest args) ;&key &allow-other-keys 
 (with-slots (gestAge fullterm-p) Obj 
  (when (and (eq gestAge 9) (eq fullterm-p 'NA) ;(not fullterm-p)
	)
      (format t "gAge:~a resets ~a" gestAge fullterm-p)
     (setf fullterm-p t))))

(defun test-hie0 (?bg ?ap)
;(when (and (< ?bg 7.1) (< ?ap 6))
; (print "found one"))
;(when (and (<= 7.1 ?bg 8.1) (<= 6 ?ap 7))
; (print "almost found one, score:"))
 (when (and (<  ?bg 8.1) (< ?ap 7)) 
	(if (and (< ?bg 7.1) (< ?ap 6))
	 (print "found one")
	 (print "almost found one, score:")))
)

(defun ltn (a b)
  "lt or nil" ;not really safe to use
  (or (not a) (not b) (< a b)))

(defun test-hie1 (?bg ?ap)
 (when (and (ltn  ?bg 8.1) (ltn ?ap 7)) 
	(if (and (ltn ?bg 7.1) (ltn ?ap 6))
	 (print "found one")
	 (print "almost found one, score:")))
)
;start w/generic test, w/inner(hard) and outer(fzy) bound
; if w/in inner 100%=1, otherwise scale to outer being 0
; do this for a whole set of vars & assume equally wted for now
;=maybe even construct the fnc,given these ranges
;defun mk-fz-lt-test (in out)
;#+ignore
(defmacro mk-fz-lt-test (in out)
  `(lambda (v)  (cond ((not (numberp v)) nil) ;so not wted in ;for now
		  	((< v ,in) 1.0)
		  	((< ,out v) 0.0)
		        (t (/ (- v ,in) (- ,out ,in))))))
;"src/utils/utils.lisp" defmacro compose (&rest functions) uses labels
;(defmacro mk-fz-lt-test (in out) (labels lt-tst

(defun qt3 (v in out) 
  "quick test, given all 3"
  (cond ((not (numberp v)) nil) ;so not wted in ;for now
        ((< v in) (print "found_one") 1.0)
	((< out v) 0.0)
	(t (print "almost found_one, score:")
	   (/ (- v in) (- out in)))))

(defun eq1 (v)
	(eq v 1.0))

(defun sum (l)
  (reduce #'+ l))
;can put ave here too, but then can print below as well, for now

(defun many-qt3 (vL inL outL)
 (let* ((scores1 (mapcar #'qt3 vL inL outL))
	(scores (remove-if #'null scores1)) ;too much safety?
	(sum (sum scores))
	(nScrs (length scores))
	(ave (/ sum nScrs))
       )
    ;if  every #'eq1 scores
    (if (eq ave 1.0)
	(print "Found One") 
	(if (plusp ave) (print "almost found_one, score:")))
  ave))
;use: (many-qt3 '(0.5 2.5 3.5) '(1.0 2.0 3.0) '(2.0 3.0 4.0))
; "found_one" "almost found_one, score:" "almost found_one, score:" 
; 0.6666667"almost found_one, score:" 
;
;now make the test-hie that uses this:
(defun test-hie (?bg ?ap)
 ;when (and (ltn  ?bg 8.1) (ltn ?ap 7)) 
	;if (and (ltn ?bg 7.1) (ltn ?ap 6))
 (many-qt3 (list ?bg ?ap) '(7 6) '(8.1 7.1)))

;(trace test-hie)
;(trace ltn)
;OBJECTIVE: The objective of this study was to determine the efficacy of mild 
;hypothermia via selective head cooling as a neuroprotective therapy in term 
;infants with perinatal asphyxia. 
;=STUDY DESIGN:  =(incl crit ~=applicable criterion)
;Full-term newborns 
;who had 5 min Apgar scores <6, 
;first arterial blood gas pH<7.10 or BD>15 mEq/l, 
;and with the clinical signs of encephalopathy 
;were enrolled within 6 h after birth. 
(defrule hie-match ()
 (newborn 
  (fullterm-p t)
  (encephalopathy-p t)
  (apgar ?ap)
  (blood-gas ?bg)
 )
=>
 (test-hie ?bg ?ap)
)
;can get cutoffs&err from kb; can get/est fz-memb from actual data 
;
;Patients were randomized to receive mild hypothermia treatment via selective head cooling 
;for a total of 72 h or receive routine treatment as a control. 
;Brain hypoxic-ischemic injury was quantified based on the head computed tomographic 
;scan (CT scan) at postnatal age 5-7 days and a Neonatal Behavioral Neurological 
;Assessment (NBNA) score at 7-10 days of life. 
;
;RESULTS: A total of 58 patients (30 hypothermia, 28 control) completed the study. 
;Hypothermia was well tolerated in this study and attenuated the hypoxic-ischemic 
;brain injury due to perinatal asphyxia. 
;Head CT scan demonstrated moderate to severe hypoxic-ischemic changes in only 4/30 
;cases from the hypothermic group. 
;In contrast, 18/28 cases in the control group showed moderate to severe hypoxic-ischemic 
;changes (chi (2)=15.97, P<0.01). 
;Brain hypothermia also significantly improved the NBNA score (32+/-2 in 
;the hypothermic group vs 28+/-3 in the control group, P<0.01). 
;
;CONCLUSIONS: Our results suggest that selective head cooling may be used as a neuroprotective 
;therapy in term neonates with perinatal asphyxia. A long-term follow-up study is 
;needed to further validate the results of this study. 
; 
; 
CL-USER(4): ; Loading /Users/bobak/Documents/downloads/lang/lsp/ai/lisa/t3.clp
#<The LISA-USER package>
T
#<STANDARD-CLASS TRAIL-BASE>
#<STANDARD-CLASS PATIENT>
#<STANDARD-CLASS NEWBORN>
:ACTIVATIONS
:FACTS
:RULES
#<RULE STARTUP>
#<STANDARD-METHOD INITIALIZE-INSTANCE :AFTER (NEWBORN)>
TEST-HIE0
LTN
TEST-HIE1
MK-FZ-LT-TEST
QT3
EQ1
SUM
MANY-QT3
TEST-HIE
#<RULE HIE-MATCH>
T
CL-USER(5): #<The LISA-USER package>
LISA-USER(6): ==> F-0 (INITIAL-FACT)
==> Activation: STARTUP : (F-0)
T
LISA-USER(7): FIRE 1: STARTUP (F-0)
gAge:9 resets NA==> F-1 (NEWBORN (GESTAGE 9) (BD NIL) (FULLTERM-P T)
                         (BLOOD-GAS 7) (ENCEPHALOPATHY-P T) (APGAR 5))
==> Activation: HIE-MATCH : (F-1)
gAge:9 resets NA==> F-2 (NEWBORN (GESTAGE 9) (BD 16) (FULLTERM-P T)
                         (BLOOD-GAS 7) (ENCEPHALOPATHY-P T) (APGAR NIL))
==> Activation: HIE-MATCH : (F-2)
gAge:9 resets NA==> F-3 (NEWBORN (GESTAGE 9) (BD NIL) (FULLTERM-P T)
                         (BLOOD-GAS 8) (ENCEPHALOPATHY-P T) (APGAR 5))
==> Activation: HIE-MATCH : (F-3)
gAge:9 resets NA==> F-4 (NEWBORN (GESTAGE 9) (BD NIL) (FULLTERM-P T)
                         (BLOOD-GAS 9) (ENCEPHALOPATHY-P T) (APGAR 5))
==> Activation: HIE-MATCH : (F-4)
FIRE 2: HIE-MATCH (F-1)

"almost found_one, score:" 
"found_one" 
"almost found_one, score:" FIRE 3: HIE-MATCH (F-2)

"almost found_one, score:" FIRE 4: HIE-MATCH (F-3)

"almost found_one, score:" 
"found_one" 
"almost found_one, score:" FIRE 5: HIE-MATCH (F-4)

"found_one" 
"almost found_one, score:" 
5
LISA-USER(8): Evaluation stack:

TPL:TOP-LEVEL-READ-EVAL-PRINT-LOOP <-
  TPL:START-INTERACTIVE-TOP-LEVEL

LISA-USER(9): EOF
; Exiting
@<13 local: /appli/lisa>