#|
How to use to characterize the mapping when using fact++

;; load results
(setq *ecocyc-ucsd-merge-log* (make-instance 'taxonomy.log :path <path to taxonomy.log, default "bug:iJR904;Taxonomy.log">))
(setq *ecocyc-ucsd-merge-log* (make-instance 'taxonomy.log :path "bug:iJR904;Taxonomy-pal.log"))

;; give statistics on counts of each size of equivalence set
(report-on-reaction-equivalences *ecocyc-ucsd-merge-log*)

;; how many unmapped ucsd reactions ? (ignore EX_ reactions) (ignore reverse reactions)
(count-unmapped-ucsd-reactions *ecocyc-ucsd-merge-log*)

;; how many unmapped ecocyc reactions
(count-unmapped-ecocyc-reactions *ecocyc-ucsd-merge-log*)

;; list unmapped reactions (ignore EX_ reactions) (ignore reverse reactions)
(list-unmapped-reactions *ecocyc-ucsd-merge-log*)

;; list of subsumptions of reactions in following format:
;; (:sub <one reaction, or a set of equivalents> :super <list of parent reactions>)
(reaction-subsumptions *ecoycyc-ucsd-merge-log*)

|#

(defparameter *fact++-readtable* (copy-readtable))

(defun braces-reader (stream char )
   (declare (ignore char))
   (read-delimited-list #\} stream t))

(defun handle-colon (stream char)
  (declare (ignore stream char))
  :colon)

; { starts a list
(set-macro-character #\{ 'braces-reader nil  *fact++-readtable*)

; } ends a list
(set-macro-character #\} (get-macro-character #\) *fact++-readtable*) nil *fact++-readtable*)

(set-macro-character #\: 'handle-colon nil *fact++-readtable*)

(defun fact++-read (stream &optional (eof-marker :eof))
  (let ((*readtable* *fact++-readtable*)
	(*package* (load-time-value (find-package :keyword))))
    (read stream nil eof-marker)))

(defclass taxonomy.log ()
  ((forms :initarg :forms :initform nil :accessor forms)
   (path :initarg :path :initform "bug:iJR904;Taxonomy.log" :accessor path)
   ))

(defmethod initialize-instance ((l taxonomy.log) &key)
  (call-next-method)
  (read-taxonomy.log l))

(defmethod read-taxonomy.log ((l taxonomy.log))
  (with-open-file (f (path l))
    (loop for line = (read-line f nil :eof)
       when (equal line "") sum 1 into count
       until  (= count 2))
    (setf (forms l)
	  (loop for form = (fact++-read f :eof)
	     until (eq form :eof)
	     collect form 
	       ))
    (length (forms l))))

;(defvar *ecocyc-ucsd-merge-log* (make-instance 'taxonomy.log :path "bug:iJR904;Taxonomy.log"))
  

(defmethod get-reaction-mapping ((l taxonomy.log))
  (let ((forms (forms l)))
    (let ((equivalence-forms 
	   (mapcar (lambda(e) (remove := e)) 
		   (remove-if-not 
		    (lambda(el) (and (listp el) (member ':= el) (some (lambda(s) (and (stringp s) (search "reaction" s))) el)))
		    forms ))))
      equivalence-forms)))

(defmethod count-unmapped ((l taxonomy.log))
  (let ((forms (forms l)))
    (let ((equivalence-forms 
	   (mapcar (lambda(e) (remove := e)) 
		   (remove-if-not 
		    (lambda(el) 
		      (and (listp el) (member ':= el) 
			   (some (lambda(s) 
				   (and (stringp s) 
					(search "reaction" s))) el)))
		    forms ))))
      equivalence-forms)))

(defmethod cross-mappings ((l taxonomy.log))
  (loop for equiv in (get-reaction-mapping l)
     when (and (some (lambda(r) (search "ecocyc" r)) equiv)
	       (some (lambda(r) (search "gcrg" r)) equiv)
	       (< (length equiv) 20))
       collect equiv))

(defmethod count-unmapped-ucsd-reactions ((l taxonomy.log))
  (length (remove-if-not (lambda(a)
			      (and (stringp a) 
				   (search "reaction" a)
				   (search "gcrg" a)
				   (not (search "EF_" a))
				   (not (search "UP_" a))
				   (not (search "DF_" a))
				   (not (search "EX_" a))
				   (not (search "reverse" a))))
			    (forms l))))

(defmethod count-unmapped-ecocyc-reactions ((l taxonomy.log))
  (length (remove-if-not (lambda(a) (and (stringp a)
					 (search "reaction" a)
					 (search "ecocyc" a)))
			 (forms l))))

(defmethod report-on-reaction-equivalences ((l taxonomy.log))
  (let ((table (make-hash-table)))
    (loop for equiv in (get-reaction-mapping l)
       when (and (some (lambda(r) (search "ecocyc" r)) equiv)
		 (some (lambda(r) (search "gcrg" r)) equiv))
	 do (incf (gethash (length equiv) table 0)))
    (let ((keys (sort (loop for k being the hash-keys of table collect k) '<)))
      (loop for k in keys
	   do (format t "~a: ~a~%" k (gethash k table))))
    (values)))

(defmethod list-unmapped-reactions ((l taxonomy.log))
  (format t "~{~A~%~}" 
	  (sort 
	   (set-difference
	    (remove-if-not
	     (lambda(a) 
	       (and (stringp a)
		    (search "reaction" a) 
		    (not (search "EX_" a))
		    (not (search "UP_" a))
		    (not (search "EF_" a))			
		    ;;(not (search "reverse" a))
		    )) 
	     (forms l))
	    (loop for (nil sub nil super) in (reaction-subsumptions l)
	       if (listp sub)
	       append sub
	       else collect sub
	       if (listp super)
	       append super
	       else collect super)
	    :test 'equalp
	    )
	   'string-lessp)))

; ("http://gcrg.ucsd.edu/reverse/reaction/AGPEAT" (1 :COLON "TOP") (1 :COLON "http://gcrg.ucsd.edu/reverse/reaction/NTPP6"))

(defmethod reaction-subsumptions ((l taxonomy.log))
  (loop for (this next) on (forms l)
       when (and (listp next)
		 (member :colon next)
		 (some (lambda(e) (and (stringp e) (search "reaction" e))) next)
		 (or (and (stringp this)
			  (search "reaction" this))
		     (and (listp this)
			  (not (member :colon this))
			  (some (lambda(e) (and (stringp e) 
						(search "reaction" e))) 
				this))))
     collect (list :sub (remove := this) :super (cddr next))))