;; This macro creates a function that takes as an argument a class describing a patient's symptoms.
;; The result of a function is a class that will be satisfiable if the patient has the diagnosis specified. 
;; The specification of a diagnosis has 3 parts.
;;  A list of inclusion criteria, for this demo a list of symptoms.
;;  A count of how many inclusion criteria need to be satisfied
;;  A list of exclusion criteria

;; The class is constructed as follows:
;;  Subclass of !diagnosedPatient - we'll use this to query for the ones that were satisfiable
;;  Subclass of patient - we will intersect the patient information with the diagnosis and see if they are consistent
;;  Creation of a property: !diagnosisSymptoms which are *all* the symptoms intersected with the inclusion criteria.
;;    But the thing is, since we don't have QCRs, we need to do this class by class, by using the inverse hasSymptoms
;;    on the class in question.
;;  Then !diagnosisSymptoms has the cardinality restriction corresponding to minimum-inclusion-criteria-count
;;  Finally we intersect with a restriction that all the symptoms can't be the exclusion criteria
;;
;; If the diagnosis is applicable then this constructed class will be satisfiable. If not it will be
;; unsatisfiable.

(defmacro diagnosis (name &key inclusion-criteria minimum-inclusion-criteria-count exclusion-criteria)
  (let ((patient (make-symbol "PATIENT")))
    `(defun ,name (&optional (,patient !patient))
     (class (make-uri (format nil "~a~a" (uri-full ,patient) (string-capitalize (string ',name))))
       :partial
       (intersection-of
	!diagnosedPatient
	,patient
	(restriction !diagnosisSymptoms
		     (all-values-from (intersection-of (union-of ,@inclusion-criteria)
						       (restriction !symptomOf (some-values-from ,patient))
						       (restriction !symptomOf (cardinality 1)))))	
	(restriction !diagnosisSymptoms (min-cardinality ,minimum-inclusion-criteria-count))
	(restriction !hasSymptom (all-values-from (complement-of (union-of ,@exclusion-criteria))))))))) 

;; Our simple diagnosis: A simple cold if you have two out of three of !sneezes, !coughs, !congested, but not if you turn blue.
(diagnosis simple-cold
	   :inclusion-criteria (!sneezes !coughs !congested)
	   :minimum-inclusion-criteria-count 2
	   :exclusion-criteria (!turnsBlue))

;; This is what the generated function would look like
'(defun simple-cold (patient)
  (class (make-uri (format nil "~aSimpleCold" (uri-full patient))) 
    :partial
    (intersection-of
     !diagnosedPatient
     patient
     (restriction !diagnosisSymptoms
		  (all-values-from (intersection-of (union-of !sneezes !coughs !congested)
						    (restriction !symptomOf (some-values-from patient))
						    (restriction !symptomOf (cardinality 1)))))
     (restriction !diagnosisSymptoms (min-cardinality 2))
     (restriction !hasSymptom (all-values-from (complement-of !turnsBlue))))
    ))

(defun patient-with-symptoms (patient &rest symptoms)
  (class patient :partial
	 (apply 'intersection-of
		patient
		(restriction !hasSymptom (cardinality (length symptoms)))
		(loop for s in symptoms collect
		     (restriction !hasSymptom (some-values-from s))))))

;; Example ontology. Note that we have to call each diagnosis function to create a class for 
;; any  patient we want to diagnose. However, in the situation where we are diagnosing a single patient
;; we can simply assume that the patient has a standard URI, then create an ontology the imports all of the
;; the diagnoses making reference to that standard patient, and then define the patient with patient
;; with symptoms.

(with-ontology test ()
    ((class !coughs :partial !symptom)
     (class !sneezes :partial !symptom)
     (class !turnsBlue :partial !symptom)
     (class !congested :partial !symptom)
     (class !eyesWater :partial !symptom)
     (class !patient :partial)
     (class !diagnosedPatient :partial)
     (annotation-property !diagnosisName)
     (disjoint-classes !coughs !sneezes !turnsBlue !eyesWater !congested)
     (disjoint-classes !patient !symptom)
     (object-property !hasSymptom (inverse-of !symptomOf))
     (object-property !diagnosisSymptoms (super !hasSymptom))
     (patient-with-symptoms !patient1 !coughs !sneezes !eyesWater)
     (patient-with-symptoms !patient2 !coughs !eyesWater)
     (patient-with-symptoms !patient3 !coughs !sneezes !turnsBlue)
     (patient-with-symptoms !patient4 !coughs !congested)
     (simple-cold !patient1)
     (simple-cold !patient2)
     (simple-cold !patient3)
     (simple-cold !patient4)
     )
  (print-db (children !diagnosedPatient))
  (write-rdfxml test "~/Desktop/test.owl")
  )