;; prototype metabolic reactions strategy

(define-ontology reaction-defs ()
  (object-property  !participant)
  (class !ReactionSide :partial)
  (object-property !hasSide (domain !Reaction) (range !ReactionSide))
  (object-property !startsWith (super !hasSide))
  (object-property !endsWith (super !hasSide))
  (class !Reaction :partial (restriction !hasSide (cardinality 2)))
  (annotation-property !reversibleReactionOf)
  (annotation-property !sideOfReaction)
  (property-property !participant (datatype-property !stoichiometry (range !xsd:int))))  

(defun has-participant (participant)
  (restriction !hasSide (some-values-from (restriction !participant (some-values-from participant)))))

(defmacro reaction (name side1 relation side2) 
  `(reaction-expression
    (eval-uri-reader-macro ,name)
    (eval-uri-reader-macro ',side1)
    ',relation (eval-uri-reader-macro ',side2)))

(defun reaction-expression (name side1 relation side2)
  (let ((leftside (internal-compound-name name :left))
	(rightside (internal-compound-name name :right))
	(directional (ecase (setq relation (intern (string relation) 'keyword))
		       (:<=> nil) (:=> t) (:<= t)))
	(description (format nil "~a ~a ~a" side1 relation side2)))
    (list*
     (class leftside :complete (annotation !sideOfReaction name) 
	    (annotation !rdfs:comment (format nil "left side of ~a" description))
	    (let ((restrictions (participants-restrictions side1)))
	      (apply 'intersection-of !ReactionSide
		     (restriction !participant (max-cardinality (length restrictions)))
		     restrictions)))
     (class rightside :complete 
	    (annotation !sideOfReaction name)
	    (annotation !rdfs:comment (format nil "right side of ~a" description))
	    (let ((restrictions (participants-restrictions side2)))
	      (apply 'intersection-of !ReactionSide
		     (restriction !participant (max-cardinality (length restrictions)))
		     restrictions)))
     (class (if directional (internal-compound-name name :reversible) name)
       :complete (annotation !reversibleReactionOf name)
       (annotation !rdfs:comment (if directional (format nil "~a <=> ~a" side1  side2) description))
       (intersection-of
	(restriction !hasSide (some-values-from leftside))
	(restriction !hasSide (some-values-from rightside))))
     (when directional
       (list (class name 
	 :complete (annotation !rdfs:comment description)
	 (intersection-of
	  (restriction (ecase relation (:=> !startsWith) (:<= !endsWith)) (some-values-from leftside))
	  (restriction (ecase relation (:=> !endsWith) (:<= !startsWith)) (some-values-from rightside)))))
       ))))

(defun participants-restrictions (expression)
  (cond ((atom expression)
	 (list (restriction (list !participant !stoichiometry '(has-value 1)) (some-values-from expression))))
	((and (consp expression)
	      (numberp (car expression)))
	 (list (restriction (list !participant !stoichiometry `(has-value ,(car expression))) 
			    (some-values-from (second expression)))))
	(t (apply 'append (mapcar 'participants-restrictions expression)))))

(defun reaction-example ()
  (with-ontology reaction-example (:includes (reaction-defs))
      ((class !lightMolecule :partial)
       (class !h :partial !lightMolecule)
       (class !o :partial)
       (class !h2o :partial)
       (disjoint-classes !h !o)
       (class !hydrogen :partial)
       (class !oxygen :partial)

       (class !L-valine :partial !L-AminoAcid)
       (class !AlphaKetoglutarate :partial )
       (class !2-keto-isovalerate :partial )
       (class !L-glutamate :partial !L-AminoAcid)
       (class !L-AminoAcid :partial)
       (equivalent-classes !hydrogen !h)
       (equivalent-classes !oxygen !o)
       (reaction !reaction1 ((2 !h) !o) <=> !h2o)
       (reaction !reaction2 !h2o => ((2 !hydrogen) !oxygen))
       (reaction !reaction3 (!L-valine !AlphaKetoglutarate) <=> (!2-keto-isovalerate !L-glutamate))
       (reaction !reaction4 (!L-AminoAcid !AlphaKetoglutarate) <=> (!2-keto-isovalerate !L-AminoAcid)))
    (print-db (equivalents !reaction1)
	      (equivalents (internal-compound-name !reaction1 :left))
	      (descendants (has-participant !o))
	      (descendants (has-participant !lightMolecule))
	      (descendants (has-participant !L-AminoAcid))
	      (descendants !reaction4))
    (show-classtree reaction-example :merge-same t)
    (write-rdfxml reaction-example)
    ))