;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))))
;- - - - -all this hie testing (below) is going away soon- - - -
(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))))) ;linear membership now
;can go w/rsm-fuzzy, but this is a good enough start for now
;as there are other things to pin down: onto->class/inst for matching, ...
(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) ;?bd
;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)))
;- - - - -all this hie testing (above) is going away soon- - - -
;(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.
(defclass app-term ()
((term :initarg :term :initform nil))
((restriction :initarg :restriction :initform nil)))
;see both what ben has done, &look at cells pkg (reminds me of garnet constraints)
(defclass study- ()
((app-terms :initarg :app-terms
:initform '())
))
;could have rules go more from study instances, full of applicability-term restrictions
;-Could break out parts&use built in cert-factor calc
;-The test function is doing a simple weighting
; as well as a very simple fz-match at the moment
;-You will see bounding-box ideas, inner&outer
;--\
; \
; \----
;in out
(defrule hie-match () ; (:belief 0.9) ;CertFactor
(newborn
(fullterm-p t)
(encephalopathy-p t)
(apgar ?ap (< ?ap 6.1))
;get bnd-box from instances describing partial applicability need
(or (blood-gas ?bg (< ?bd 8.1))
(bd ?bd (> 16.1 ?bd)))
)
;(test (test-hie ?bg ?ap)) ;can put test here
=>
(test-hie ?bg ?ap) ;?bd
;save/assert value(s) for belief that there is a match
;(format t "newborn match(~,3F)~%" (belief:belief-factor ?newborn))
)
;time to generalize &move tests into object/methods
;get umls/snowmed code in; but use AllegroStore (instead of mysql)if ACL is used
; can be a prelude to the use of AllegroGraph &related reasoning abilities.
;Other than just rsm-fuzzy; see what clos based stats-libs are now being used,
; if not much, introduce one; Mix-in w/a measure/unit breakdown ..
;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.
;
;