(in-package :ec)

;;; Source code for MetaCyc vs. Kegg comparison as found in "A systematic comparison of the MetaCyc and KEGG pathway databases".

;; This file contains code for importing KEGG into a Pathawy Tools Pathway/Genome Database (PGDB), and code for comparing
;; MetaCyc and KEGG. Each of these tools has its own code sections.
;; Code was developed in Allegro Common Lisp, Enterprise Edition, version 8.2, from Franz, Inc., in conjunction
;; with the Pathway Tools software, which can be obtained under license from SRI International.

;;; Table of Contents
;;
;; * Code for using the KEGG SOAP API to reconstruct flat-files
;; * Building XKeggCyc from KEGG flat-files:
;;   * Code to create XKeggCyc PGDB
;;   * Importer Lowest Level: Parsing and transformation machinery
;;   * Importer Middle Level: Read Files, Convert to PGDB
;;   * Importer Highest Level: Build KEGG PGDB
;;   * Importer Miscellaneous
;; * Code for comparing MetaCyc and XKeggCyc PGDBs
;; * Code to find correspondences between KEGG and MetaCyc compounds and reactions using XKeggCyc


;;;; :::::::::::::::::::::::::::::::::: Code for using the KEGG SOAP API to reconstruct flat-files ::::::::::::::::::::::::::::::::::::::

;; The below code assumes that the reader is familiar with the Kegg SOAP API:
;; http://www.kegg.jp/kegg/soap/

;; Load the modified BioBike Lisp code file. Currently I have a copy here:
;; ~taltman/dev/SRI/projects/kegg-comp/code/kegg-soap.lisp
;; 
;; Then, execute the following to initialize the API:
;; (keggapi)
;; 
;; The next function to call is: print-kegg-flat-files


;; ====================================================================== get-kegg-entry-definition-list
;; 
;; taltman:Jul-3-2012 
;;    Description : For a given list of objects returned via the Kegg SOAP API, 
;;                  return a list of object identifiers corresponding to each
;;                  object encoded in the SOAP data structure.
;; 
;;      Arguments : Raw SOAP response from KEGG.
;;                  
;;        Returns : Two values. First value is a list of identifiers for each KEGG 
;;                  object found in the raw response. The second list is the
;;                  corresponding list of KEGG objects in the SOAP datastructure.
;;   Side Effects : None.
;; Update History :

(defun get-kegg-entry-definition-list (raw-response)
  (let ((response-array (second (second raw-response))))
    
    (loop for (entry-id-list definition-list) across response-array
	for entry-id = (second (tokenize-string (second entry-id-list)
						:separators '(#\:)))
	for definition = (second definition-list)
			 			 
	collect entry-id into ids
	collect (list entry-id definition) into definitions
						
	finally
	  (return (values ids
			  definitions)))))
			  

;; For a SOAP response, extract part of data structure that has vector of the entry objects:
(defun get-kegg-identifier-vector (raw-response)
  (second (second raw-response)))


;; ====================================================================== get-list-of-kegg-organisms
;;
;; taltman:Jul-3-2012 
;;    Description : Obtain list of Kegg organisms.
;; 
;;      Arguments : None.
;;                  
;;        Returns : Two values. The first value is a list of identifiers 
;;                  for each Kegg organism. The second list is the corresponding
;;                  list of raw SOAP entries for each organism.
;;   Side Effects : Executes Kegg SOAP API function.
;; Update History :

(defun get-list-of-kegg-organisms ()
  (let ((raw-response (kegg::list-organisms)))       
    (values
     (get-kegg-entry-definition-list raw-response)
     raw-response)))

;; ====================================================================== get-kegg-reference-pathways
;; 
;; taltman:Jun-29-2012 
;;    Description : Fetch the total set of KEGG reference pathways. 
;;                  Takes about 5 seconds wall time
;; 
;;      Arguments : None.
;;                  
;;        Returns : Two values. First value is a list of strings, where each
;;                  string is a KEGG map identifier. The second value is a list of the
;;                  full data structures for each pathway as returned by the 
;;                  SOAP call.
;;   Side Effects : Accesses KEGG via the SOAP API.
;; Update History :

(defun get-kegg-reference-pathways ()
  (format t "~A" (second (second (kegg::binfo :db "path"))))
  (let ((raw-response (kegg::list-pathways :org "map")))  
    (values
     (get-kegg-entry-definition-list raw-response)
     raw-response)))

;; ====================================================================== get-kegg-compound-identifiers
;; 
;; taltman:Jun-29-2012 
;;    Description : Fetch the full set of non-glycan KEGG COMPOUND entries.
;;                  Takes about 26 seconds wall time.
;; 
;;      Arguments : None.
;;                  
;;        Returns : Two values. First value is a list of strings, where each 
;;                  string is a KEGG LIGAND COMPOUND identifier. The second
;;                  value is a list of the full data structures for the
;;                  compounds as returned by the SOAP call.
;;   Side Effects : Accesses KEGG via the SOAP API.
;; Update History :

(defun get-kegg-compound-identifiers ()
  (format t "~A" (second (second (kegg::binfo :db "compound"))))
  (let ((raw-response (second (second (kegg::bfind :string "compound C")))))
    (loop for line in (tokenize-string raw-response
				       :separators '(#\Newline))
	collect (second (multiple-value-list (excl:match-re "C[0-9]{5}" line))) into identifiers
	collect line into raw-lines
			  
	finally
	  (return (values identifiers
			  raw-lines)))))

;; ====================================================================== get-kegg-reaction-identifiers
;; 
;; taltman:Jun-29-2012 
;;    Description : Fetch the full set of non-glycan KEGG REACTION entries.
;;                  Takes about 1:40 wall time.
;; 
;;      Arguments : None.
;;                  
;;        Returns : Two values. First value is a list of strings, where each 
;;                  string is a KEGG LIGAND REACTION identifier. The second
;;                  value is a list of the full data structures for the
;;                  reactions as returned by the SOAP call.
;;   Side Effects : Accesses KEGG via the SOAP API.
;; Update History :

(defun get-kegg-reaction-identifiers ()
  (format t "~A" (second (second (kegg::binfo :db "reaction"))))
  (let ((raw-response (second (second (kegg::bfind :string "reaction R")))))
    (loop for line in (tokenize-string raw-response
				       :separators '(#\Newline))
	collect (second (multiple-value-list (excl:match-re "R[0-9]{5}" line))) into identifiers
	collect line into raw-lines
			  
	finally
	  (return (values identifiers
			  raw-lines)))))

;; ====================================================================== get-kegg-compound-identifiers
;; 
;; taltman:Jun-29-2012 
;;    Description : Fetch the full set of non-glycan KEGG COMPOUND entries.
;;                  Takes about 30 minutes wall time.
;; 
;;      Arguments : None.
;;                  
;;        Returns : Two values. First value is a list of strings, where each 
;;                  string is a KEGG LIGAND COMPOUND identifier. The second
;;                  value is a list of the full data structures for the
;;                  compounds as returned by the SOAP call.
;;   Side Effects : Accesses KEGG via the SOAP API.
;; Update History :

(defun get-kegg-module-identifiers ()
  (format t "~A" (second (second (kegg::binfo :db "module"))))
  (let ((raw-response (second (second (kegg::bfind :string "module M")))))
    (loop for line in (tokenize-string raw-response
				       :separators '(#\Newline))
	when (not (excl:match-re "^md\:.*_.*" line))
	collect (second (multiple-value-list (excl:match-re "M[0-9]{5}" line))) into identifiers
	and
	collect line into raw-lines
			  
	finally
	  (return (values identifiers
			  raw-lines)))))


;; ====================================================================== get-raw-kegg-map-pathway-entries
;; 
;; taltman:Jul-3-2012 
;;    Description : For list of Kegg reference pathway map identifiers, return
;;                  list of SOAP datastructures for each pathway map.
;; 
;;      Arguments : kegg-reference-pathways: (Optional) Defaults to all Kegg reference pathways, as returned by (get-kegg-reference-pathways)
;;                  limit: (Keyword) The number of pathways to download. Defaults to 5.
;;                  ;;                  
;;        Returns : List of SOAP data structures for each pathway identifier.
;;   Side Effects : Accesses Kegg SOAP API.
;; Update History :

(defun get-raw-kegg-map-pathway-entries (&optional (kegg-reference-pathways (get-kegg-reference-pathways))
					 &key (limit 5))
  (loop for (kegg-id nil) in (subseq kegg-reference-pathways
			       0 limit)
      collect (kegg::bget :string kegg-id)))


;; ====================================================================== scrape-out-module-references
;; 
;; taltman:Jul-3-2012 
;;    Description : From a raw Kegg Map entry encoded via SOAP, 
;;                  extract out the Kegg module identifiers.
;; 
;;      Arguments : Kegg Map entry encoded via SOAP.
;;                  
;;        Returns : List of Kegg Module identifiers.
;;   Side Effects : None.
;; Update History :

(defun scrape-out-module-references (map-pathway-bget-entry)
  (let ((entry-string (second (second map-pathway-bget-entry)))) 
    (loop for line in (tokenize-string entry-string :separators '(#\Newline))
	when (search "DESCRIPTION" line)	     
	append (match-re-multiple "(M[0-9]+){1,}" line))))


;; ====================================================================== get-raw-kegg-module-pathway-identifiers
;; 
;; taltman:Jul-3-2012 
;;    Description : For list of raw Kegg Map entries encoded via SOAP,
;;                  collect all corresponding Kegg Module identifiers.
;; 
;;      Arguments : raw-kegg-map-pathway-entries: A list of raw Kegg Map 
;;                  entries.
;;                  
;;        Returns : A list of Kegg Module identifiers.
;;   Side Effects : None.
;; Update History :

(defun get-raw-kegg-module-pathway-identifiers (raw-kegg-map-pathway-entries)
  (loop for kegg-raw-entry in raw-kegg-map-pathway-entries
      for module-ids = (loop for bare-id in (scrape-out-module-references kegg-raw-entry)
			   collect (concatenate 'string "module:" bare-id))
      append module-ids into all-module-ids
			      
      finally
	(return (remove-duplicates all-module-ids 
				   :test #'string-equal))))


;; ====================================================================== get-kegg-pathway-compounds
;; 
;; taltman:Jul-3-2012 
;;    Description : Loop over every Kegg Map pathway, and collect identifiers 
;;                  of all corresponding compounds.
;;                  This takes ~4 minutes to process. 
;; 
;;      Arguments : kegg-reference-pathways: (Optional) List of identifiers 
;;                       for Kegg reference Map pathways. Defaults to result 
;;                       of calling get-kegg-reference-pathways.
;;                  limit: (Keyword) The maximum number of pathways to process. 
;;                         Defaults to 5.
;;        Returns : List of compound identifiers.
;;   Side Effects : Accesses the Kegg SOAP API.
;; Update History :

(defun get-kegg-pathway-compounds (&optional (kegg-reference-pathways (get-kegg-reference-pathways))
				   &key (limit 5))
  (let ((cpd-hash (make-hash-table :test #'equalp
				   :size (with-organism (:org-id 'meta)
					   (* (length (get-class-all-instances '|Compounds|))
					      3)))))
    
    (loop for (entry-id nil) in (subseq kegg-reference-pathways				
					0 limit)
	do (loop for kegg-cpd-id across (get-kegg-identifier-vector (kegg::get-compounds-by-pathway :pathway_id entry-id))
	       do (setf (gethash kegg-cpd-id cpd-hash)
		    t)))
		 	       
    (loop for entry-id being the hash-keys in cpd-hash
	collect entry-id)))


;; ====================================================================== get-kegg-pathway-reactions
;; 
;; taltman:Jul-3-2012 
;;    Description : Iterate over all Kegg reference maps, and collect all 
;;                  referenced Kegg reaction identifiers.
;; 
;;      Arguments : kegg-reference-pathways: (Optional) List of Kegg map pathway objects.
;;                       Defaults to the result of calling get-kegg-reference-pathways.
;;                  limit: (Keyword): The maximum number of pathways to process. Defaults to 5.
;;                  
;;        Returns : A list of Kegg compound identifiers.
;;   Side Effects : Accesses the Kegg SOAP API.
;; Update History :

(defun get-kegg-pathway-reactions (&optional (kegg-reference-pathways (get-kegg-reference-pathways))
				   &key (limit 5))
  (let ((rxn-hash (make-hash-table :test #'equalp
				   :size (with-organism (:org-id 'meta)
					   (* (length (get-class-all-instances '|Reactions|))
					      3)))))
    
    (loop for (entry-id nil) in (subseq kegg-reference-pathways				
					0 limit)
	do (loop for kegg-rxn-id across (get-kegg-identifier-vector (kegg::get-reactions-by-pathway :pathway_id entry-id))
	       do (setf (gethash kegg-rxn-id rxn-hash)
		    t)))
		 	       
    (loop for entry-id being the hash-keys in rxn-hash
	collect entry-id)))


;; Utility for stripping out the SOAP metadata from a bget entry:

(defun kegg-bget-entry (raw-bget-reply)
  (second (second raw-bget-reply)))


;; ====================================================================== print-kegg-flat-file
;; 
;; taltman:Jul-3-2012 
;;    Description : Given a list of Kegg identifiers or Kegg SOAP objects,
;;                  extract the ASCII entry for the object and write it to a file. 
;;                  A file with the version of the dataset used is also written.
;; 
;;      Arguments : kegg-identifiers: A list of Kegg object identifiers.
;;                  kegg-bget-raw-entries: A list of raw Kegg objects encoded via SOAP. 
;;                      If this list is not provided, then the kegg-identifiers list is 
;;                      used to obtain the objects.
;;                  output-file: The name of the file to write the output to.
;;                  
;;        Returns : Nothing.
;;   Side Effects : Accesses the Kegg SOAP API and writes out a file.
;; Update History :

(defun print-kegg-flat-file (&key kegg-identifiers
				  kegg-bget-raw-entries				   
				  output-file)

  (let ((kegg-db-prefix-alist '(("R" . "rn")
				("M" . "md")
				("C" . "cpd")
				("map" . "path"))))
    
    (when (null kegg-bget-raw-entries)
      (setf kegg-bget-raw-entries
	(loop for kegg-id in kegg-identifiers
	    for id-prefix = (if (string-equal (subseq kegg-id
						      0 3)
					      "map")
				"map"
			      (subseq kegg-id
				      0 1))
	    for db-prefix = (cdr (assoc id-prefix
					kegg-db-prefix-alist
					:test #'string=))
	    collect (kegg::bget :string (concatenate 'string
					  db-prefix
					  ":"
					  kegg-id))))))
  
  (with-open-file (out (concatenate 'string
			 output-file
			 ".version.txt")
		   :direction :output
		   :if-exists :supersede)
    (format out "~A~%" (second (second (kegg::binfo :db "kegg"))))
    (format out "~A~%" (second (second (kegg::binfo :db "path"))))
    (format out "~A~%" (second (second (kegg::binfo :db "module"))))
    (format out "~A~%" (second (second (kegg::binfo :db "reaction"))))
    (format out "~A~%" (second (second (kegg::binfo :db "compound")))))
  
  (with-open-file (out output-file
		   :direction :output
		   :if-exists :supersede)
    
    (loop for raw-entry in kegg-bget-raw-entries 		       
	do (format out "~A" (kegg-bget-entry raw-entry)))))

;; ====================================================================== print-kegg-flat-files
;; 
;; taltman:Jul-3-2012 
;;    Description : Save to disk the Kegg MAP, MODULE, COMPOUND, and REACTION 
;;                  files via thee Kegg SOAP API. Also creates a file that details
;;                  the version of each dataset file.
;;
;; Todo: * Extend this to dump out the result of kegg::binfo "ligand" to a version file
;;       * Extend this to use full-list of objects for downloading (instead of using Kegg reference Maps as the basis)
;; 
;;      Arguments : limit: (Keyword) Maximum objects to print to each file. Defaults to 5. 
;;                  
;;        Returns : Nothing.
;;   Side Effects : Accesses the Kegg SOAP API. Writes out files to filesystem.
;; Update History :

(defun print-kegg-flat-files (&key (limit 5))
  
  (let* ((kegg-reference-pathways (get-kegg-reference-pathways))
	 (raw-kegg-map-pathway-entries (get-raw-kegg-map-pathway-entries kegg-reference-pathways :limit limit)))
    (print-kegg-flat-file :kegg-bget-raw-entries raw-kegg-map-pathway-entries
			  :output-file "kegg-reference-map-pathways")
    (print-kegg-flat-file :kegg-identifiers (get-raw-kegg-module-pathway-identifiers raw-kegg-map-pathway-entries)
			  :output-file "kegg-module-pathways")
    (print-kegg-flat-file :kegg-identifiers (get-kegg-pathway-compounds kegg-reference-pathways :limit limit)
			  :output-file "kegg-compounds")
    (print-kegg-flat-file :kegg-identifiers (get-kegg-pathway-reactions kegg-reference-pathways :limit limit)
			  :output-file "kegg-reactions")))



;;;; ::::::::::::::::::::::::::::: Code to create XKeggCyc PGDB ::::::::::::::::::::::::::

#|
An entirely new KEGG importer
Mike Travers, Apr 2011

The name of this file was chosen to avoid calling it "kegg-new-importer", since what is new today will eventually become old.

Use:
- See documentation on READ-KEGG for the files used. The latest version of KEGG known to work is 58.0+/06-19
- (build-kegg-all) will read the KEGG source files (from *ligand-directory*) and build a new XKEGG PGDB (in *xkegg-directory*)

Theory of operation:
- There are two phases for the import:
-- first, files are read, parsed, and the contents stored as properties on symbols in the KEGG package
    This is Implemented with the KEGG-HANDLER method.
-- second, iterate over those symbols and turn them into PGDB frames, using standard Metacyc names where possible
    Implemented with MAKE-KEGG-FRAME and CONVERT-KEGG-SLOT methods.

Notes on input data:
Each ligand file is organized as a set of records, separated by a line starting "///" and headed by and ENTRY field 
which gives the object ID (eg C00023).  A record is a set of fields, which come in a variety of formats (eg, some
are multiple lines, some are object ids while others are strings).  The KEGG-HANDLER methods define the parse
strategy for each field in a particular file (see the def-kegg-handler documentation).

Some records (objects) contain subrecords (subobjects).  Fields of subobjects are identified by lines starting with a space.
Eg, in the example below, ENTRY1 defines a subrecord with fields COMPOUND and ATOM.  These are handled by defining
KEGG symbols of the form RP0003_ENTRY1.
///
ENTRY       RP00003                     RPair
NAME        C00002_C00008
COMPOUND    C00002  ATP
            C00008  ADP
TYPE        main ligase
...
ENTRY1
  COMPOUND  C00002
  ATOM      31
            1   N4y N     7.4091  -11.6324
            2   C8y C     8.0332  -12.0669
            3   C1y C     6.6504  -11.8773
            4   C8x C     7.6918  -10.8083
            5   C8y C     8.7608  -11.5324



Todo:
- ENTRY lines can have clasess (ie ENTRY       C00746            Peptide   Compound)
   there's not that many of these actually.
- store rpairs in PGDB
|#

(defparameter *ligand-directory* "~brg/bio/databases/KEGG/2011-06-29/ligand/")
;;; Newer version, obtained through KEGG web service
;(defparameter *ligand-directory* "~brg/bio/databases/KEGG/2012-02-27/")
(defparameter *xkegg-directory* nil) ;;kr:Oct-26-2011 breaks build: (pathname "~travers/keggdb/")
(defvar *xkegg-kb* nil)
(defparameter *condense-same-as?* nil)	;t to try to merge KEGG entries that are linked by "same as" relations

(defun xkegg-kb ()
  (or *xkegg-kb*
      (progn (so 'xkegg)
	     (setq *xkegg-kb* (current-kb)))))


;;;; :::::::::::::::::::::::::::::: Importer Lowest Level: Parsing and transformation machinery ::::::::::::::::::::::::::::::

;; ====================================================================== def-kegg-handler
;; 
;;    Description : Macro that defines how to parse fields in KEGG LIGAND source files.  
;;
;;                  The macro defines a method KEGG-HANDLER that is specialized on CLASS and FIELD. KEGG-HANDLER methods parse the
;;                  LIGAND files and record the results on symbol property lists in the KEGG package.
;;                  
;;                  If SLOT is specified, the macro also defines a CONVERT-KEGG-SLOT method which handles converting the above
;;                  information into PGDB form, optionally using the TRANSLATE argument to convert the value into the proper form.
;;      Arguments : CLASS: Keyword describing the KEGG class and file involved (eg :compound) 
;;                  FIELD: Keyword describing the field id in the LIGAND source (eg :mass)
;;                  HANDLER: Name of a function for dealing with this type of line
;;                    The function takes args (OBJECT FIELD LINE), where
;;                        OBJECT is symbol in the KEGG package
;;                        FIELD is as above
;;                        LINE is the text of the line
;;                   the function can either modifiy the FIELD of OBJECT itself, or just return a value to be stored in SLOT
;;                 SLOT: (optional) if present, the name of a PGDB slot to store the value
;;                 TRANSLATOR: (optional) a function to convert the values on KEGG symbol plists into values suitable for storing into the PGDB
;;                 IGNORE: (optional) If non-nil, ignore this field.  It doesn't make sense to specify both this and SLOT.
;;        Returns : -
;;   Side Effects : Defines KEGG-HANDLER and CONVERT-KEGG-SLOT methods
;; Update History : -

(defmacro def-kegg-handler (class field handler &key slot translator ignore)
  `(progn
     (defmethod kegg-handler ((class ,(if (keywordp class) `(eql ,class) t))
			      (field (eql ,field))
			      object
			      line)
       (declare (ignorable class))
       (,handler object field line)
       )
     ,(when slot
	    `(defmethod convert-kegg-slot ((class ,(if (keywordp class) `(eql ,class) t))
					   (field (eql ,field))
					   value 
					   frame)
	       (declare (ignorable class field value frame))
	       (let ((cvalue ,(if translator `(mapcar ',translator value) 'value)))
		 (if (listp cvalue)
		     (put-slot-values frame ',slot cvalue)
		     (put-slot-value frame ',slot cvalue)))))
     ,(when ignore
	    `(defmethod convert-kegg-slot ((class ,(if (keywordp class) `(eql ,class) t))
					   (field (eql ,field))
					   value 
					   frame)
	       (declare (ignore value frame))
	       ))))

;; ====================================================================== kegg-handler
;; 
;;    Description : Generic function; each method defines how to handle particular types of lines in KEGG LIGAND source files
;; 
;; 
;;      Arguments : CLASS: Keyword describing the KEGG class (eg :compound)
;;                  FIELD: Keyword describing the field id in the LIGAND source (eg :mass)
;;                  OBJECT: Symbol in KEGG package that represents the KEGG object
;;                  LINE: Content part of line in LIGAND file (field name omitted)
;;        Returns : none
;;   Side Effects : modifies field of OBJECT
;; Update History : -

(defgeneric kegg-handler (class field object line))


;; ====================================================================== convert-kegg-slot
;; 
;;    Description : Generic function; each method defines a way to convert from raw KEGG values to PGDB slot values
;; 
;; 
;;      Arguments : CLASS: Keyword describing the KEGG class (eg :compound)
;;                  FIELD: Keyword describing the field id in the LIGAND source (eg :mass)
;;                  VALUE: The value generated by phase 1 parse
;;                  FRAME: The PGDB frame to store into
;;        Returns : none
;;   Side Effects : modifies FRAME
;; Update History : -

(defgeneric convert-kegg-slot (class field value frame))

;;; Some generic (all KEGG classes) handlers
(def-kegg-handler t :name kegg-parse-text-lines)

(defmethod convert-kegg-slot ((class t) (field (eql :name)) value frame)
  (put-slot-value frame 'common-name (car value))
  (put-slot-values frame 'synonyms (cdr value)))

(def-kegg-handler t :dblinks kegg-parse-text-lines :slot dblinks :translator parse-dblink)
(def-kegg-handler t :comment kegg-parse-text-line :slot comment) 
;;(def-kegg-handler t :reference kegg-parse-text-lines :slot citations)

;;; Compound
;;; Note: in KEGG 58.0, this is MOL_WEIGHT, in earlier versions it was MASS, so define both.  There is also an EXACT_MASS field which we ignore
(def-kegg-handler :compound :mass kegg-parse-number-line :slot molecular-weight)
(def-kegg-handler :compound :mol_weight kegg-parse-number-line :slot molecular-weight)
(def-kegg-handler :compound :formula kegg-parse-text-line :ignore t) ;redundant, computed
(def-kegg-handler :compound :reaction kegg-parse-objects :ignore t) ;assume this is inverse
(def-kegg-handler :compound :enzyme kegg-parse-tokens)
(def-kegg-handler :compound :pathway kegg-parse-object+kruft)
(def-kegg-handler :compound :atom kegg-parse-vector) 
(def-kegg-handler :compound :bond kegg-parse-vector-2 :slot structure-bonds :translator kegg-xlate-bond)

;;; maps Gxxx -> Cxxx
(defvar *compound-sames* (make-hash-table :test 'eq))

(defmethod kegg-handler ((class (eql :compound)) (field (eql :remark)) object line)
  (declare (ignorable class))
  (multiple-value-bind (match ignore sames)
      (excl:match-re (compiled-re "Same as: (.*)") line)
    (declare (ignore ignore))
    (when match
      (dolist (same (split-string-better sames))
	(setf (gethash (keggid->symbol same) *compound-sames*) object)))))


;;; Special-cased because the same line specs atoms and coords 
(defmethod convert-kegg-slot ((class (eql :compound))
			      (field (eql :atom))
			      value
			      frame)
  (let ((atom-list (cdr (coerce value 'list))))
    (multiple-value-bind (atoms charges)
	(kegg-xlate-atom-list atom-list)
    (put-slot-values frame 'structure-atoms atoms)
    (put-slot-values frame 'atom-charges charges) 
    (put-slot-values frame 'display-coords-2d
		     (mapcar #'(lambda (ac)
				 (list (read-from-string (third ac))
				       (- (read-from-string (fourth ac))))) ;invert y, then it comes out same as KEGG picture
			     atom-list)))))

;;; Translator for atom list fields, eg the ATOM field in the ligand/compound.
;;; Input is the raw parse of the field, which looks something like this:
;;; (("N4y" "N" "29.0166" "-14.4798")
;;;  ("C8y" "C" "30.0765" "-15.2194")
;;;  ("C1y" "C" "27.7235" "-14.8990")...)
;;; Outputs two values, a list of atom symbols and a list of charges, suitable for storing into the 
;;; STRUCTURE-ATOMS and ATOM-CHARGES fields of a PGDB, respectively.  Note that the coordinate positions are dealt with
;;; separately.
(defun kegg-xlate-atom-list (atom-list)
  (let ((atoms nil)
	(charges nil))
    (dolist (ac atom-list)
      (let* ((a (read-from-string (second ac)))
	     (a1
	      (case a
		(|R#| 'R)	;R# is disallowed frame name; I guess R is the standard.
		(* 'R)		;* is also disallowed from frame names 
		(h+ 
		 'h) 
		(t a)))
	     (charge
	      (cond ((eq a 'h+) 1)
		    ((equal "#+" (nth 4 ac)) 1)
		    ((equal "#-" (nth 4 ac)) -1)
		    (t nil))))
	(unless (get-frame-named a1 :error-p nil :kb (xkegg-kb))
	  (warn "element ~A not found, creating" a1)
	  (create-instance a1 '|Elements|))
	(push a1 atoms)
	(when charge
	  (push (list (1+ (position ac atom-list)) charge) charges))))
    (values (nreverse atoms) (nreverse charges))))


;;; Translator for bond fields, eg the BOND field in the ligand/compound.
;;; Input is the raw parse of the field, which is a sequence that looks something like this:
;;; with each line specifying a bond in terms of two atom indexes, an arity, and optional flags for sterochemistry information
;;; #(NIL
;;;   ("1" "2" "1") 
;;;   ("3" "1" "1" "#Up")
;;;   ("1" "4" "1")...)
;;; Outputs a list suitable for storing into the STRUCTURE-BONDS field of a PGDB.
;;; Note: not called by normal KEGG import, but used for rpairs
(defun kegg-xlate-bonds (bond-seq)
  (mapcar #'(lambda (bc)
	      (let ((base (mapcar #'parse-integer (subseq bc 0 3))))
		(awhen (nth 3 bc)	;chirality info
		  (let ((raw-key (mt:up-keywordize (subseq it 1))))
		    (mt:push-end (ecase raw-key
				   (:either :wiggly) ;I believe these are equivalent, should ask someone.
				   (:up :up) (:down :down))
				 base)))
		base))
	  ;; first elt is count
	  (cdr (coerce bond-seq 'list))))

(defun kegg-xlate-bond (bc)
  (let ((base (mapcar #'parse-integer (subseq bc 0 3))))
    (awhen (nth 3 bc)	;chirality info
      (let ((raw-key (mt:up-keywordize (subseq it 1))))
	(mt:push-end (ecase raw-key
		       (:either :wiggly) ;I believe these are equivalent, should ask someone.
		       (:up :up) (:down :down))
		     base)))
    base))


; :sequence, :bracket, random cruft

;;; Handlers for the individual LIGAND files

;;; Glycan
(def-kegg-handler :glycan :mass kegg-parse-number-line :slot molecular-weight)
;;;(def-kegg-handler :glycan :class kegg-parse-text-lines) ;(actually ; separated names) +++ I suppose these should be objectified...
(def-kegg-handler :glycan :reaction kegg-parse-objects :ignore t) ;assume this is inverse
(def-kegg-handler :glycan :pathway kegg-parse-object+kruft)
(def-kegg-handler :glycan :enzyme kegg-parse-tokens)
(def-kegg-handler :glycan :dblinks kegg-parse-text-lines :ignore t) ;different from regular dblinks, and we ignore for now
(def-kegg-handler :glycan :node kegg-parse-text-lines :ignore t)	    ;ignore this stuff for now
(def-kegg-handler :glycan :edge kegg-parse-text-lines :ignore t)
(def-kegg-handler :glycan :composition kegg-parse-text-lines :ignore t)
(def-kegg-handler :glycan :reference kegg-parse-text-lines :ignore t)
(def-kegg-handler :glycan :remark kegg-parse-same-as)


;;; Reaction
(def-kegg-handler :reaction :definition kegg-parse-text-line)
(def-kegg-handler :reaction :equation kegg-parse-equation-line)
(def-kegg-handler :reaction :rpair kegg-parse-object+kruft :slot rpairs 
		  :translator symbol-name) ;ignore the annotations, they are redundant
;;; change in translator makes this hard...it also seems kind of arbitrary  :translator car) ;PK says only one ec number, so discard the rest
(def-kegg-handler :reaction :enzyme kegg-parse-tokens :slot ec-number)
(def-kegg-handler :reaction :orthology kegg-parse-object+kruft)
(def-kegg-handler :reaction :reference kegg-parse-ignore) ;different than refs in Enzyme, and prob redundant
(def-kegg-handler :reaction :pathway kegg-parse-object+kruft :slot in-pathway :translator kegg-xlate-pathway-link)
(def-kegg-handler :reaction :remark kegg-parse-same-as)


(defmethod convert-kegg-slot ((class (eql :reaction)) (field (eql :left)) value frame)
  (add-cpds-with-stoich frame 'left value))

(defmethod convert-kegg-slot ((class (eql :reaction)) (field (eql :right)) value frame)
  (add-cpds-with-stoich frame 'right value))

(defun add-cpds-with-stoich (frame slot value)
  (put-slot-values frame slot (mapcar #'(lambda (pair) (kegg->frame (->kegg-compound (car pair)))) value))
  (dolist (pair value)
    (when (and (cadr pair) 
	       (> (cadr pair) 1))
      (put-value-annot frame slot (kegg->frame (->kegg-compound (car pair))) 'coefficient (cadr pair)))))

;;; Enzyme (not used at present)
(def-kegg-handler :enzyme :class kegg-parse-text-lines) ;These should be objectified...they 
(def-kegg-handler :enzyme :substrate kegg-parse-ignore) ;Assume redundant with reactions
(def-kegg-handler :enzyme :product kegg-parse-ignore)

;;; Rpair
(def-kegg-handler :rpair :type kegg-parse-text-line)
(def-kegg-handler :rpair :compound kegg-parse-object+kruft)
(def-kegg-handler :rpair :rclass kegg-parse-object+kruft)
(def-kegg-handler :rpair :relatedpair kegg-parse-objects)
(def-kegg-handler :rpair :enzyme kegg-parse-objects)
(def-kegg-handler :rpair :reaction kegg-parse-objects) ;hm, we already have inverse, oh well.
(def-kegg-handler :rpair :align kegg-parse-vector)
(def-kegg-handler :rpair :rdm kegg-parse-vector) ;+++ should probably parse these apart a bit...

(defmethod kegg-subobject-start? ((class t) (field t) object line)
  (declare (ignore object line))
  nil)

(defmethod kegg-subobject-start? ((class (eql :rpair)) (field (eql :entry1)) object line)
  (kegg-parse-subobject object field line))

(defmethod kegg-subobject-start? ((class (eql :rpair)) (field (eql :entry2)) object line)
  (kegg-parse-subobject object field line))

(defun kegg-parse-subobject (object field line)
  (declare (ignore line))
  (let ((subobj (keggid->symbol (format nil "~A_~A" object field) t)))
    (setf (get object field) subobj)
    subobj))

(def-kegg-handler :rpair :|  ATOM| kegg-parse-vector)
(def-kegg-handler :rpair :|  BOND| kegg-parse-vector)
(def-kegg-handler :rpair :|  COMPOUND| kegg-parse-object+kruft)

(defmethod kegg-handler ((class t) (field t) object line)
  (declare (ignorable object line))
;;; for debugging
;  (warn "Can't handle ~S ~S from ~S while parsing ~A" class field line object)
  )


;;;  Handlers for various KEGG line formats

;;; Ignore a field
(defun kegg-parse-ignore (object field line)
  (declare (ignore object field line)))

;;; Parse multiple text lines into a list
(defun kegg-parse-text-lines (object field line)
  (when (and (not (string= line ""))
	     (char= #\; (mt::last-elt line)))
    (setf line (subseq line 0 (1- (length line)))))
  (push-end line (get object field)))

;;; Parse a single text line
(defun kegg-parse-text-line (object field line)
  (setf (get object field) line))

;;; Parse the "Same as" comments found in REMARK fields
(defun kegg-parse-same-as (object field line)
  (declare (ignore field))
  (when *condense-same-as?*
    (multiple-value-bind (match ignore sames)
	(excl:match-re (compiled-re "Same as: (.*)") line)
      (declare (ignore ignore))
      (when match
	(print `(same-as ,object ,sames))
	(setf (get object :same-as) sames)))))




		     

;; ====================================================================== kegg-parse-equation-line
;; 
;;    Description : Parse a KEGG equation line, eg "EQUATION    C01010 + C00001 <=> 2 C00011 + 2 C00014"
;; 
;;      Arguments : OBJECT: The KEGG symbol for the reaction.
;;                  FIELD: ignored
;;                  LINE: The content of the line (not including field name)
;;        Returns : none
;;   Side Effects : adds :LEFT and :RIGHT properties to OBJECT.
;;                  Each is a list of lists of the form (kegg-compound-symbol stoich) where stoich is nil or an integer
;; Update History : -
;; Note: some reactions are polymerizing, eg: EQUATION    C00677 + C00039(n) <=> C00013 + C00039(n+1)
;; At the moment we discard the (n) notations, probably this behavior could be improved +++
(defun kegg-parse-equation-line (object field line)
  (declare (ignore field))
  (let* ((parsed (split-string-better line))
	 ;; KEGG doesn't appear to encode reaction direction, they all seem bidirectional...
	 (arrow-pos (position "<=>" parsed :test #'equal)))
    (flet ((parse-stoich (list)
	     (collecting
	       (dotimes (i (length list))
		 (when (member (char (nth i list) 0) '(#\C #\G) :test #'char=)
		   (collect (list (keggid->symbol (subseq (nth i list) 0 6)) ;here's where the (n) tokens are removed
				  (and (plusp i)
				       (parse-integer (nth (1- i) list) :junk-allowed t)))))))))
      (setf (get object :left) 
	    (parse-stoich (subseq parsed 0 arrow-pos)))
      (setf (get object :right)
	    (parse-stoich (subseq parsed arrow-pos))))))

;;; Parse a number
(defun kegg-parse-number-line (object field line)
  (setf (get object field) (read-from-string line)))

;;; Parse a field that consists of references to other KEGG objects
(defun kegg-parse-objects (object field line)
  (setf (get object field)
	(append (mapcar #'keggid->symbol (mt:string-split line #\Space))
		(get object field))))

;;; Parse arbitrary tokens (which will be interpreted at a later stage)
(defun kegg-parse-tokens (object field line)
  (setf (get object field)
	(append (split-string-better line)
		(get object field))))

;;; Parse fields that consist of an id + text on a single line
(defun kegg-parse-object+kruft  (object field line)
  (let* ((name (read-token line))
	 (sym (keggid->symbol name))
	 (cruft (trim-whitespace (subseq line (length name))))) 
    (setf (get sym :cruft) cruft)	;store this which is often the long name of the object
    (push-end sym
	      (get object field))))

;;; Split a string into substrings based on whitespace.
(defun split-string-better (string)
  (excl:split-re "\\s+" string))

;;; Parse a field that consists of a vector (eg ATOM lists)
(defun kegg-parse-vector (object field line)
  (let ((tokens (split-string-better line)))
    (cond ((or (= 1 (length tokens))
	       ;; There are some rpairs with lines like this: (+++ might want to capture similarity value)
	       ;; ALIGN       9  #similarity=0.400000
	       (char= #\# (char (cadr tokens) 0)))
	   (setf (get object field) (make-sequence 'vector (1+ (parse-integer (car tokens)))))) ;preserve 1-based scheme
	  ;; special case, :align has extra entries that don't go in the vector! POS!
	  ((and (eq field :align)
		(equal "-" (car tokens)))
	   (push (cdr tokens) (get object :unalign)))
	  (t 
	   (setf (svref (get object field) (parse-integer (car tokens)))
		 (cdr tokens))))))

;;; better version, works better with translate, returns a list without extra count elt
(defun kegg-parse-vector-2 (object field line)
  (let ((tokens (split-string-better line)))
    (cond ((or (= 1 (length tokens))
	       ;; There are some rpairs with lines like this: (+++ might want to capture similarity value)
	       ;; ALIGN       9  #similarity=0.400000
	       (char= #\# (char (cadr tokens) 0)))
	   (setf (get object field) (make-sequence 'list (parse-integer (car tokens)))))
	  ;; special case, :align has extra entries that don't go in the vector! POS!
	  ((and (eq field :align)
		(equal "-" (car tokens)))
	   (push (cdr tokens) (get object :unalign)))
	  (t 
	   (setf (nth (1- (parse-integer (car tokens))) (get object field))
		 (cdr tokens))))))
      
;;; The first stage of parsing creates symbols in the KEGG package, with fields recorded on the plist of these symbols
(unless (find-package :kegg)
  (make-package :kegg))

(defun reset-kegg-package ()
  (delete-package :kegg)
  (make-package :kegg))

;;; Turn a KEGG ID string (eg "R00012") into a symbol (eg KEGG::R00012).
;;; If DEFINE? is T, reset the symbol's property list
(defun keggid->symbol (id &optional define?)
  (let ((sym (intern id :kegg)))
    (when define?
      (setf (symbol-plist sym) nil))
    sym))

;;; As above, but only return existing symbols.
(defun keggid->symbol-existing (id)
  (find-symbol id :kegg))

(defun read-token (string &optional (from 0) include-leading-whitespace?)
  (multiple-value-bind (match? substr group)
      (excl:match-re (compiled-re
		      (if include-leading-whitespace?
			 "(\\s*\\w+)"
			 "\\s*(\\w+)"))
		     string
		     :start from)
    (declare (ignore substr))
    (if match?
	group
	(error "Token not found"))))

;;;; ::::::::::::::::::::::::::::::  Importer Middle Level: Read Files, Convert to PGDB  ::::::::::::::::::::::::::::::


;; ======================================================================  read-kegg
;;    Description :  Reads KEGG files into symbols and property lists, with minimal interpretation.
;;                   The symbols used are of the form KEGG::C00023, property names are keyword corresponding
;;                   to the fields in the ligand data files.  Details of the parse are defined by KEGG-HANDLER 
;;                   methods.
;;                   currently, the files read in to generate XKEGG are:
;;                   -  compound, glycan, reaction from *ligand-directory*  
;;                   -  /home/rockpile1/brg/bio/databases/KEGG/58.0+/05-16/module-reference-2011-06-29
;;                      [not part of ligand, and we don't have an uptodate copy, so we do our best]
;;                   -  possibly others added by Tomer
;;      Arguments : LIMIT: (optional) an integer. if present, only read that many objects (useful for testing)
;;                  RPAIRS?: (optional) T to include a parse of the rpair data (not needed for PGDB construction)
;;        Returns : A hash table where keys are the KEGG package symbols.
;;   Side Effects : Creates the symbols and properties
;; Update History :

(defun read-kegg (&key limit rpairs? suppress-glycan?)
  (let* ((kegg-symbols (make-hash-table :test #'eq))
	 (collector #'(lambda (class sym)
			(declare (ignore class))
			(setf (gethash sym kegg-symbols) t))))
    (process-kegg-file (merge-pathnames *ligand-directory* "compound") :compound :limit limit :collector collector)
    (when (not suppress-glycan?)
      (process-kegg-file (merge-pathnames *ligand-directory* "glycan") :glycan :limit limit :collector collector))
    ;; Experimental parsing of "map" file:
    ;; The order of the following three calls to process-kegg-file is important. Do not change.
    (process-kegg-file (merge-pathnames *ligand-directory* "map") :map :limit limit :collector collector)
    (process-kegg-file (merge-pathnames *ligand-directory* "reaction") :reaction :limit limit :collector collector)
    (process-kegg-file (merge-pathnames *ligand-directory* "module") :module :limit limit :collector collector)
;    (process-kegg-file "/home/rockpile1/brg/bio/databases/KEGG/58.0+/05-16/module-reference-2011-06-29" 
;		       :module :limit limit :collector collector)
    (when rpairs?
      (process-kegg-file (merge-pathnames *ligand-directory* "rpair") :rpair :limit limit :collector collector))
    kegg-symbols))

(defun process-kegg-file (file class &key limit collector)
  (format t "~%Reading ~A" file)
  (let (object subobject tmp command (count 0) (line-count 0))
    (with-open-file (s file)
      (block doit
	(mt::dolines (line s)
	  (incf line-count)
	  (cond ((mt:string-prefix-equals line "ENTRY   ")
		 (let ((tokens (split-string-better line)))
		   (setq object (keggid->symbol (second tokens) t)
			 subobject nil)
		   (setf (get object :classes) (cddr tokens))
		   (setf (get object :ktype) class)
		   (when collector
		     (funcall collector class object)))
		 (incf count))
		((mt:string-prefix-equals line "           ")
		 (kegg-handler class command (or subobject object) (subseq line 12)))
		((mt:string-prefix-equals line "///")
		 (setf object nil)
		 (when (and limit (>= count limit))
		   (return-from doit)))
		;; ok, this is kinda ugly.  Read the command, then check to see if it starts a subobject
		((setq command (mt:keywordize (read-token line 0 t))
		       tmp (kegg-subobject-start? class command object line))
		 (setq subobject tmp)
		 ;; maybe process the line? not necessary for entry1/2
		 )
		;; In the midst of a subobject  -- (see head of file for explanation of subobjects)
		(subobject
		 (kegg-handler class command subobject (subseq line 12)))
		;; starting a normal field.
		(t
		 (kegg-handler class command object (subseq line 12))
		 ))))
      (format t "~%~A ~As parsed with ~A lines." count class line-count))))

;;; Frame conversion

(defun read-kegg-to-frames (&rest args)
  (let ((ht (apply #'read-kegg args)))
    (flet ((process (pred)
	     (loop for kegg being each hash-key in ht
		when (funcall pred kegg)
		do (convert-kegg-frame nil kegg))))
      ;; do these in a particular order to avoid problems
      (process #'(lambda (kegg) (char= #\C (char (symbol-name kegg) 0))))
      (process #'(lambda (kegg) (char= #\G (char (symbol-name kegg) 0))))
      (process #'(lambda (kegg) (char= #\R (char (symbol-name kegg) 0))))
      (process #'(lambda (kegg) (char= #\M (char (symbol-name kegg) 0))))
      (process #'(lambda (kegg) (not (member  (char (symbol-name kegg) 0) 
					      '(#\C #\R #\G #\M)
					      :test #'char=)))))))

;;; Convert a KEGG symbol to a frame name. This first tries to find an existing Metacyc frame to use, and if one is not found
;;; synthesizes a new frame name of the form KEGG-<keggid>.
(mt:def-cached-function kegg->frame (kegg-id)
  (let* ((kegg-name (symbol-name kegg-id))
	 (db (case (char kegg-name 0) (#\C 'ligand-cpd) (#\R 'ligand-rxn)))
	 (frames (when db (find-linked-objects db kegg-name :kb *ref-kb* :return-class-frames? t))))
    (if (> (length frames) 1)
	(warn ">1 frame for ~A: ~A" kegg-name frames))
    (if frames
	(let* ((frame (car frames))
	       (already-kegg (get-slot-value frame 'kegg-id)))
	  (if (and already-kegg (not (equal kegg-name already-kegg)))
	      (progn
		(warn "~A can't be mapped to ~A because it's already mapped to ~A" frame kegg-id already-kegg)
		;; so use the other strategy
		(intern (mt:string+ "KEGG-" kegg-name) :ec))
	      (progn 
		(put-slot-value frame 'kegg-id kegg-name)
		(get-frame-name frame))))
	;; no frames
	(intern (mt:string+ "KEGG-" kegg-name) :ec))))


(defmethod convert-kegg-frame ((type null) kegg)
  (aif (get kegg :ktype)
    (convert-kegg-frame it kegg)
    (if (mt:string-prefix-equals (symbol-name kegg) "rn")
	(convert-kegg-frame :pathway kegg)
	(error "Can't determine type of ~A" kegg))))
    
;;; bookkeeping, ignore
(defmethod convert-kegg-slot ((class t) (field (eql :ktype)) value frame)
  (declare (ignore frame value)))

(defmethod convert-kegg-frame ((type symbol) kegg)
  (let ((frame (make-kegg-frame type kegg)))
    (when frame
      (do ((rest (symbol-plist kegg) (cddr rest))) ;sorry, don't know how to do this in loop
	  ((null rest))
	(let ((prop (car rest))
	      (val (cadr rest)))
	  (convert-kegg-slot type prop val frame)))
      ;; Link back to KEGG!
      (awhen (case type
	       (:compound 'ligand-cpd)
	       (:reaction 'ligand-rxn)
	       (t 'ligand))		;nothing hits this yet, but
	(add-slot-value frame 'dblinks (make-link :db it :oid (symbol-name kegg))))
      frame)))

(defmethod convert-kegg-frame ((type (eql :rpair)) kegg)
  (declare (ignore kegg)))					;no-op for now

;; ====================================================================== make-kegg-frame
;; 
;;    Description : Generic function; Given a type (eg :compound) and kegg-id, return an XKEGG instance frame
;; 
;;      Arguments : TYPE: Keyword identifying the object type (eg :compound)
;;                  KEGG-ID: the KEGG pkg symbol
;;        Returns : An instance from  in XKEGG
;; Update History : -

(defgeneric make-kegg-frame (type kegg-id))

(defmethod make-kegg-frame :around ((type t) kegg-id)
  (aif (get-frame-named (kegg->frame kegg-id) :error-p nil :kb *xkegg-kb*)
    ;; warning happens too much for rnXXXXX frames, so disable it
    (progn ; (warn "Frame ~A already exists" it)
	   it)
    (call-next-method)))

(defmethod make-kegg-frame :around ((type (eql :glycan)) kegg-id)
  (if (get kegg-id :same-as)
      (format t "~%Skipping ~A because it is the same as ~A" kegg-id (get kegg-id :same-as))
    (call-next-method)))

;;; Only make reactions if they are not duplicates with glycans
(defmethod make-kegg-frame :around ((type (eql :reaction)) kegg-id)
  (if (or (not (get kegg-id :same-as))
	    (and (every #'(lambda (pair) (char= #\C (char (symbol-name (car pair)) 0)))
			(get kegg-id :left))
		 (every #'(lambda (pair) (char= #\C (char (symbol-name (car pair)) 0)))
			(get kegg-id :right))))
      (call-next-method)
      (progn 
	(format t "~%Skipping ~A because it is the same as ~A" kegg-id (get kegg-id :same-as))
	nil
	)))

(defmethod make-kegg-frame ((type t) kegg-id)
  (create-instance (kegg->frame kegg-id) (kegg-pgdb-types type kegg-id) :error-p nil))

(defmethod kegg-pgdb-types ((type (eql :compound)) kegg-id)
  (declare (ignore kegg-id))
  '|Compounds|)

(defmethod kegg-pgdb-types ((type (eql :glycan)) kegg-id)
  (declare (ignore kegg-id))
  '|Compounds|)				;+++ would make sense to use a compound subclass, but which?

(defmethod make-kegg-frame ((type (eql :compound)) kegg-id)
  (if (some #'(lambda (atom) (equal (second atom) "R")) (get kegg-id :atom))
      (create-class (kegg->frame kegg-id) (kegg-pgdb-types type kegg-id))
      (call-next-method)))

;; ====================================================================== kegg-pgdb-types
;; 
;;    Description : Return the appropriate PGDB class object for a KEGG frame
;; 
;;      Arguments : TYPE: Keyword identifying the object type (eg :compound)
;;                  KEGG-ID: the KEGG pkg symbol
;;        Returns : class for instance creation
;; Update History : -

(defgeneric kegg-pgdb-types (type kegg-id))

(defmethod kegg-pgdb-types ((type (eql :compound)) kegg-id)
  (declare (ignore kegg-id))
  '|Compounds|)

(defmethod kegg-pgdb-types ((type (eql :reaction)) kegg-id)
  (cons '|Reactions|
	(mt:collecting
	  (dolist (ec-string (get kegg-id :enzyme))
	    (let ((ec-parts (excl:split-re "\\." ec-string))) 
	      (unless (and ec-parts 
			   (equal (mt::last-elt ec-parts) "-")) ;; look for classes
		(let ((parent (get-frame-named (intern (mt:string+ "EC-" (mt:string-join (butlast ec-parts) #\.)))
					       :error-p nil :kb *xkegg-kb*)))
		  (when parent
		    (mt:collect-new parent)))))))))

(defmethod convert-kegg-slot (type prop val frame)
  (declare (ignorable frame val type prop))
  ;; for development, turn off in practice
					;  (warn "no slot converter for ~A ~A" type prop)
  )

;;; link will be a rn00130-like or map00130-like symbol
(defun kegg-xlate-pathway-link (link)
  (let ((pwy-str (symbol-name link)))
    (make-kegg-frame :pathway
		     (intern (if (string= (subseq pwy-str 0 2)
					  "rn")				 
				 (concatenate 'string
				   "map"
				   (subseq pwy-str 2))
			       pwy-str)
			     (kb-package (current-kb))))))
  


;;; Builds and returns a KEGG KB, with standard PGDB class hierarchy but without KEGG content
(defun build-kegg ()
  (let* ((kegg-id 'xkegg)		;kegg is taken
	 (kegg-kb (create-kb-for-orgid kegg-id
				       :dbms-type :file
				       :species-name "KEGG"
				       :full-species-name "KEGG"
				       :version (format nil "~A-~A-~A" (kegg-version) (sys:user-name) (get-universal-time))
				       :root-pathname *xkegg-directory*
				       )))
    (create-cycproject-dir-tree kegg-kb)
    (write-organism.dat kegg-kb)
    (open-org-kb kegg-kb :status :new)
    (setq *ref-kb* (find-kb 'metabase))
    (open-kb :kb *ref-kb*)
    (setq gfp::*current-kb* kegg-kb)	;better way to do this?
    (setq *current-species* kegg-id)
    (populate-kb 9999)			;+++ not sure what org-counter arg should be
    (save-kb)
    (setq *xkegg-kb* kegg-kb)
    kegg-kb))
;;; Kegg alignment



;;; Ad-hoc adjustments to XKEGG
;;; Before parse
(defun kegg-pre-fixups ()
  (create-class '|Modules| '|Pathways|)
  (put-slot-value '|Modules| 'comment "This class contains all KEGG module pathways")
  (create-class '|Pathway-Maps| '|Pathways|)
  (put-slot-value '|Pathway-Maps| 'comment "This class contains all KEGG map pathways")
  )

;;; After parse and frame creation
(defun kegg-post-fixups ()
  (put-slot-value 'c 'common-name "C") ;ok, maybe do this for all elements! +++
  (put-slot-value 'p 'common-name "P")
  (put-slot-value 'o 'common-name "O")
  (put-slot-value 'n 'common-name "N"))  


#||
;; Insert KEGG MODULE dblinks via scraped dataset from 06/29/2011 download of KEGG
;; This will eventually be replaced with proper parser once we get complete 58.0 download.

(defun add-module-dblinks (&key verbose?)
  (with-organism (:org-id 'xkegg)
    (index-ekb)
    (let ((nlinks 0)
	  (module-rxn-map (with-open-file (in "/homedir/taltman/dev/SRI/projects/kegg-comp/data/module-dblink-map.lisp")
			    (read in))))
      (loop for (module . rxns) in module-rxn-map
	  when verbose?				   
	  do (format t "Module ~A, rxns: ~A~%" module rxns)
	  do
	     (loop for kegg-rxn in rxns
		 for rxn-frames = (find-linked-objects 'ligand-rxn
						       (symbol-name kegg-rxn))
		 do
		   (loop for rxn in rxn-frames
		      when verbose?
		      do (format t "Adding module ~A to rxn ~A. ~%" module (get-frame-name rxn))
		      do
			(incf nlinks)
			   (add-link rxn
				     (make-link :db 'kegg-module
						:oid (symbol-name module)
					     :relationship 'related)))))
      (format t "Added ~A links from reactions to modules~%" nlinks)
      )))
||#

(defun inchify-kegg-compounds ()
  (with-organism (:org-id 'xkegg)
    (time (loop for cpd in (get-frame-all-children '|Compounds|)
	      do (update-inchi-of-cpd cpd)))))


;;;; ::::::::::::::::::::::::::::::  Importer Highest Level: Build KEGG PGDB  ::::::::::::::::::::::::::::::


;;; mt pubuntu setup: 
;;; (build-kegg-all :ligand-directory "~travers/Downloads/ligand/" :xkegg-directory "~travers/keggdb/" :skip-inchi-string-creation? t)

(defun build-kegg-all (&key 
		       (ligand-directory *ligand-directory*)		       
		       (xkegg-directory "~brg/aic/pgdbs/sri-private/")
		       skip-inchi-string-creation? ;; when non-nil, skip creation of standard InChI strings for Kegg compounds (used for searching KEGG for duplicates.
		       condense-same-as?
		       suppress-glycan?) ;; when non-nil, we do not bother trying to parse the glycan file.
  (setq *condense-same-as?* condense-same-as?)	
  (ignore-errors (close-kb :kb (find-org 'xkegg) :save-updates-p nil))
  (reset-kegg->frame)			;clear this cache out
  (reset-kegg-package)
  (setq *ligand-directory* (pathname ligand-directory))
  (setq *xkegg-directory* (pathname xkegg-directory))
  (excl:shell (format nil "mv ~axkeggcyc ~axkeggcyc.old" (namestring xkegg-directory) (namestring xkegg-directory)))
  (build-kegg)
  (so'xkegg)
  (kegg-pre-fixups)
  (read-kegg-to-frames :suppress-glycan? suppress-glycan?)
  (kegg-post-fixups)
  (when (not skip-inchi-string-creation?)
    (inchify-kegg-compounds))
  (save-kb))


;;;; ::::::::::::::::::::::::::::::  Importer Miscellaneous  ::::::::::::::::::::::::::::::


(defun kegg-version ()
  (with-open-file (s (merge-pathnames *ligand-directory* ".dbinfo.ligand"))
    (mt:dolines (l s)
      (when (mt:string-prefix-equals l "DBREL=")
	(return-from kegg-version (substitute #\- #\/ (subseq l 6)))))))

;;; New stuff to try to infer kegg mappings that don't exist yet.

(defun unique-to-kegg? (r)
  (null (get-frame-named (get-frame-name r) :kb (find-kb 'metabase) :error-p nil)))

(defun kegg-unique-rxns ()
  (with-organism (:org-id 'xkegg)
    (filter #'unique-to-kegg? (all-rxns :all))))

(defun rxn-has-metacyc-cpds (r)
  (not (some #'unique-to-kegg? (get-slot-values r 'substrates))))

;;; kr is a kegg rxn with all metacyc cpds, this will return possible metacyc rxns
(defun possible-matching-rxns (kr)
  (let* ((ksubstrates (mapcar #'get-frame-name (get-slot-values kr 'substrates)))
	 (mrxns (metacyc-reactions (car ksubstrates) :both)))
    (filter #'(lambda (mrxn)
		(ffset-equal (get-slot-values mrxn 'substrates) ksubstrates))
	    mrxns)))

(defun produce-rxn-matches ()
  (collecting 
    (dolist (kr (kegg-unique-rxns))
      (awhen (possible-matching-rxns kr)
	(collect (print (cons kr it)))))))

(defun all-cpds-better (&key (structure-only? t))
  (filter (if structure-only? #'has-structure-p #'identity)
	  (append (get-class-all-subs '|Compounds|)
		  (get-class-all-instances '|Compounds|))))

;;; Look for cpds
(defun kegg-unique-cpds ()
  (with-organism (:org-id 'xkegg)
    (filter #'(lambda (c) (and (has-structure-p c)
				(unique-to-kegg? c)))
	    (all-cpds-better))))

(defun find-matching-cpds-smiles ()
  (dolist (c (kegg-unique-cpds))
    (awhen (match-kb (->smiles c) :kb (find-kb 'metabase))
      (print (list c it)))))
  
;;; :::::::::::::::: Modules

;;; REACTION lines look like:
;            R01015  C00111 -> C00118
;            R01061,R01063  C00118 -> C00236

(def-kegg-handler :module :reaction kegg-parse-module-rxn-line :slot reaction-list :translator kegg->frame)
(def-kegg-handler :module :class kegg-parse-module-classes)
;;(def-kegg-handler :module :pathway kegg-parse-object+kruft :slot in-pathway :translator kegg-xlate-pathway-link)

(defun kegg-parse-module-rxn-line (object field line)
  (setf (get object field)
	(append (mt:filter #'identity (mapcar #'keggid->symbol-existing (match-re-multiple "R\\d+" line)))
		(get object field))))

(defmethod kegg-pgdb-types ((type (eql :module)) kegg-id)
  (declare (ignore kegg-id))
  '|Modules|)



(defun kegg-parse-module-classes (object field line)
  (declare (ignore field))
  (funcall (kegg-parse-pathway-classes :module) object line))

;;; Ignore non-pathway modules (cf mail from Tomer 5/1/2012)
(defmethod convert-kegg-frame :around ((type (eql :module)) kegg)
  (when (equal "Pathway" (car (get kegg :classes)))
    (let ((frame (call-next-method)))
      (if (get kegg :parent-class)
	  (put-instance-types frame (list (get kegg :parent-class)))
	(put-instance-types frame '(|Modules|))))))


; (defmethod convert-kegg-frame :around ((type (eql :module)) kegg)
;   (let ((frame (call-next-method)))
;     (put-instance-types frame (list (get kegg :class)))))



;;; :::::::::::::::: Pathways

(defmethod kegg-pgdb-types ((type (eql :map)) kegg-id)
  (declare (ignore kegg-id))
  '|Pathway-Maps|)

(def-kegg-handler :map :reaction kegg-parse-module-rxn-line :slot reaction-list :translator kegg->frame)
(def-kegg-handler :map :description kegg-parse-text-line :slot comment)
(def-kegg-handler :map :class kegg-parse-map-classes) ;; not defined yet!

;;(def-kegg-handler :map :reference kegg-parse-text-lines :slot citation)) ;; not defined yet!
;;(def-kegg-handler :map :rel_pathway ??? :slot pathway-link) ;; skip for now

(defun kegg-parse-map-classes (object field line)
  (declare (ignore field))
  (funcall (kegg-parse-pathway-classes :map) object line))

(defmethod convert-kegg-frame :around ((type (eql :map)) kegg)
  (let ((frame (call-next-method)))
    (if (get kegg :parent-class)
	(put-instance-types frame (list (get kegg :parent-class)))
      (put-instance-types frame '(|Pathway-Maps|)))))

(defun kegg-parse-pathway-classes (pathway-type)
  
  (lambda (object line)
    (let ((parsed-classes (excl::split-re ";\\s+" line))
	  (last-class (if (eq pathway-type :map )
			  '|Pathway-Maps|
			'|Modules|)))     
      
      (loop for class-name in parsed-classes
			      
	  for hyphenated-class-name = (intern (substitute #\- 
							  #\Space 
							  (cond ((string= class-name
									  "Biosynthesis of Other Secondary Metabolites")
								 "Biosynthesis Other Secondary Metabolites")
								((string= class-name
									  "Xenobiotics Biodegradation and Metabolism")
								 "Xenobiotic Biodegradation and Metabolism")
								((string= class-name
									  "Folding, Sorting and Degradation")
								 "Folding Sorting and Degradation")
								((string= class-name
									  "Alkaloid and other secondary metabolite biosynthesis")
								 "Alkaloid secondary metabolite biosynth")
								((string= class-name
									  "Phenylpropanoid and flavonoid biosynthesis")
								 "Phenylpropanoid flavonoid biosynthesis")
								((string= class-name
									  "Phosphate and amino acid transport system") 
								 "Phosphate amino acid transport system")
								((string= class-name
									  "Metallic cation, iron-siderophore and vitamin B12 transport system") 
								 "Metal cation siderophore B12 transport")
								((string= class-name
									  "Phosphotransferase system (PTS)") 
								 "Phosphotransferase system PTS") 
								((string= class-name
									  "Energy Metabolism") 
								 "Energy Metabolism KEGG")

									     (t class-name)))
					      (kb-package (current-kb)))
				      
	  when (and (not (string= hyphenated-class-name
				  "Structural-complex"))
		    (not (coercible-to-frame-p hyphenated-class-name)))
	  do (create-class hyphenated-class-name (list last-class))
	     (put-slot-value hyphenated-class-name 'common-name class-name)
	  end
	    
	  when (not (string= hyphenated-class-name
			     "Structural-complex"))
	  do (setf last-class hyphenated-class-name))
      
      (setf (get object :parent-class)
	last-class))))



; (defmethod convert-kegg-frame :around ((type (eql :pathway)) kegg)
;   (let ((frame (call-next-method)))
;     (setf (get-slot-value frame 'common-name) 
; 	  (get kegg :cruft))
;     frame))



;;;; :::::::::::::::::::::::::::::::::::: Code for comparing MetaCyc and XKeggCyc PGDBs ::::::::::::::::::::::::::::::::::


;;; Convenience utilities for working with XKeggCyc:	    

;; Predicate to see if KEGG compound is from the GLYCAN database:

(defun xkegg-glycan-cpd (cpd)
  (if (symbolp cpd)
      (search "KEGG-G" (symbol-name cpd))
    (search "KEGG-G" (symbol-name (get-frame-name cpd)))))


;; Predicate to see if KEGG reaction has substrates from the GLYCAN database:

(defun xkegg-glycan-rxn (rxn)
  (loop for cpd in (get-slot-values rxn 'substrates)
      thereis (xkegg-glycan-cpd cpd)))


;; Predicate to see if KEGG compound is from the DRUG database:

(defun xkegg-obsolete-drug-cpd (cpd)
  (search "Transferred to D" 
	  (get-slot-value cpd 
			  'common-name)))


;; Predicate to see if KEGG compound is "valid" for the sake of our analyses:

(defun valid-xkegg-cpd-p (cpd)
  (and (not (xkegg-glycan-cpd cpd))
       (not (xkegg-obsolete-drug-cpd cpd))
       (not (all-child-of-p cpd '|Elements|))
       (not (all-child-of-p cpd '|Groups|))))


;; Returns XKeggCyc non-Global pathway instances:
;; Global pathways are very large, summarize all of metabolism, most likely do not reflect biological pathways, and skew our statistics.
;; Root class should be one of the three following pathway classes: |Pathways|, |Pathway-Maps|, or |Modules|
(defun xkegg-non-global-pwy-instances (&key (root-class '|Pathways|))
  (with-organism (:org-id 'xkegg)
    (let ((xkegg-bad-pwy-classes (xkeggcyc-pwy-classes-to-avoid)))
      (loop for pwy in (set-difference (frame-list-to-names (get-class-all-instances root-class))
				       '(|KEGG-map01100| ;; These are three "Global" Pathways to avoid.
					 |KEGG-map01120|
					 |KEGG-map01110|))
	  when (loop for bad-class in xkegg-bad-pwy-classes
		   never (all-child-of-p pwy bad-class))
	  collect pwy))))


;; Return all kegg maps as a list of symbol map IDs:
(defun all-kegg-maps ()
  (xkegg-non-global-pwy-instances :root-class '|Pathway-Maps|))
  
;; Return all kegg modules as a list of symbol module IDs:
(defun all-kegg-modules ()
  (xkegg-non-global-pwy-instances :root-class '|Modules|))
  
;; Return the rxns of a kegg map as a list of rxn frame names:
(defun reactions-of-kegg-map (map)
  (get-slot-values map 'reaction-list) )

;; Return the rxns of a kegg module as a list of rxn frame names:
(defun reactions-of-kegg-module (module)
  (get-slot-values module 'reaction-list) )

;; Return reactions that are present in at least one KEGG Map:
(defun get-kegg-map-rxns ()
  (with-organism (:org-id 'xkegg)
        (frame-list-to-names (loop for pwy in (xkegg-non-global-pwy-instances :root-class '|Pathway-Maps|)
			     append (get-slot-values pwy 'reaction-list) into rxns
			     finally
			       (return (remove-duplicates rxns :test #'fequal))))))

;; Return reactions that are present in at least one KEGG Module:
(defun get-kegg-module-rxns ()
  (with-organism (:org-id 'xkegg)
    (frame-list-to-names (loop for pwy in (xkegg-non-global-pwy-instances :root-class '|Modules|)
			     append (get-slot-values pwy 'reaction-list) into rxns
			     finally
			       (return (remove-duplicates rxns :test #'fequal))))))

;; Return the substrates of a kegg map as a list of cpd frames:
(defun compounds-of-kegg-map (map)
  (fremove-duplicates
   (loop for r in (get-slot-values map 'reaction-list)
	 append (get-slot-values r 'substrates) ) ) )

;; Return the substrates of a kegg module as a list of rxn frames:
(defun compounds-of-kegg-module (module)
  (fremove-duplicates
   (loop for r in (get-slot-values module 'reaction-list)
	 append (get-slot-values r 'substrates) ) ) )

;; Return all XKegg reactions that have corresponding reactions in MetaCyc (16.0):
(defun xkegg-rxns-linked-to-metacyc (rxns)
  (loop for rxn in rxns
      for rxn-name = (get-frame-name rxn)
      when (with-organism (:org-id 'meta)
	     (coercible-to-frame-p rxn-name))
      collect rxn-name))

;; Return all MetaCyc (16.0) reactions that have dblinks to KEGG:
(defun metacyc-rxns-linked-to-xkegg (rxns)
  (loop for rxn in rxns
      when (get-links rxn :db 'ligand-rxn)
      collect (get-frame-name rxn)))

;; Return a list of XKeggCyc pathway classes that should have their pathway instances excluded from our analyses.
;; Exclusion is due to the pathway classes describing non-metabolic pathways (i.e., pathways with no reactions or compounds)

(defun xkeggcyc-pwy-classes-to-avoid ()
  (let ((pwy-classes  (loop for pwy-class in (append (get-class-all-subs '|Pathway-Maps|)
						     (get-class-all-subs '|Modules|))
			  for pwys = (get-class-all-instances pwy-class) 
			  when (loop for pwy in pwys 
				   always (null (reactions-of-pathway pwy))) 
			  collect pwy-class)))
    
    (loop for pwy-class in pwy-classes
	when (loop for pwy-class2 in pwy-classes
		 never (all-child-of-p pwy-class pwy-class2))
	collect (get-frame-name pwy-class))))
		      

;;; Stats-related utilities:

;; A standard measure of set similarity:
(defun jaccard-coefficient-set (intersection-size set-A-size set-B-size)
  (float (/ intersection-size
	    (+ set-A-size 
	       set-B-size
	       (- intersection-size)))))

;; Draw random sample from MetaCyc compounds with no links to KEGG compounds:
(defun population-to-sample-for-cpd-match-test (sample-size)
  (so 'meta "16.0")
  (with-organism (:org-id 'meta)
    (subseq (statistics:shuffle (loop for cpd in (cons '|Compounds|
						       (mapcar #'get-frame-name
							       (get-frame-all-children '|Compounds|)))
				    when (and (not (get-links cpd :db 'ligand-cpd)) (has-structure-p cpd))
				    collect cpd))
	    0 
	    sample-size)))

;; Draw random sample from MetaCyc reactions with no links to KEGG reactions:
(defun population-to-sample-for-rxn-match-test (sample-size)
  (so 'meta "16.0")
  (with-organism (:org-id 'meta)
    (subseq (statistics:shuffle (loop for rxn in (get-class-all-instances '|Reactions|)
				    when (not (get-links rxn :db 'ligand-rxn))
				    collect rxn))
	    0 
	    sample-size)))

;; Draw random sample from KEGG reactions with no links to MetaCyc reactions:
(defun kegg-sample-for-rxn-match-test (sample-size)
  (so 'meta "16.0")
  (with-organism (:org-id 'xkegg)
    (subseq (statistics:shuffle (loop for rxn in (get-class-all-instances '|Reactions|)
				    for rxn-name = (get-frame-name rxn)
				    when (search "KEGG-" (symbol-name rxn-name))
				    collect rxn-name))
	    0 
	    sample-size)))




;; ====================================================================== evaluate-accuracy
;;
;; taltman:Jul-5-2012 
;;    Description : Utility function for evaluating the confusion matrix of 
;;                  predicted vs. actual object pairs. Works for reactions 
;;                  or compounds. Used for evaluating how well our matching 
;;                  algorithms work. Returns accuracy, false positive, false 
;;                  negative, true positive, and true negative rates. One 
;;                  way to come up with pairs to evaluate would be to pick a 
;;                  sample of MetaCyc compounds linked to KEGG compounds, and 
;;                  make a list of the compound pairs. Then, have a curator 
;;                  review the list to determine which pairs are correct, and 
;;                  which ones are incorrect.
;;
;;      Arguments : true-pairs: A list of frame ID pairs (list of length two), 
;;                       where the first frame ID is from MetaCyc, and the 
;;                       second is from XKeggCyc. These should be the pairs 
;;                       that were determined to be true correspondences as 
;;                       declared by a curator.
;;
;;                  all-pairs: A list of frame ID pairs (list of length two), 
;;                       where the first frame ID is from MetaCyc, and the 
;;                       second is from XKeggCyc. These should be the full set
;;                       of pairs of objects that were evaluated by a curator, 
;;                       and will contain both true-pairs and false pairs.
;;                  
;;        Returns : Five values: the accuracy rate, the false positive rate, 
;;                  the false negative rate, the true positive rate, and the
;;                  true negative rate.
;;   Side Effects : None.
;; Update History :

(defun evaluate-accuracy (true-pairs all-pairs)
  (let* ((false-pairs (set-difference all-pairs
				      true-pairs
				      :test #'equalp))
	 (positive-pairs (loop for (m-rxn k-rxn) in all-pairs
			     when (valid-rxn-match? m-rxn k-rxn)
			     collect (list m-rxn k-rxn)))
	 (negative-pairs (loop for (m-rxn k-rxn) in all-pairs
			     when (not (valid-rxn-match? m-rxn k-rxn))
			     collect (list m-rxn k-rxn)))
	 (true-positive (intersection positive-pairs
				      true-pairs
				      :test #'equalp))
	 (false-positive (intersection positive-pairs
				       false-pairs
				       :test #'equalp))
	 (true-negative (intersection false-pairs
				      negative-pairs
				      :test #'equalp))
	 (false-negative (intersection negative-pairs
				       true-pairs
				       :test #'equalp))
	 (error-rate (float (/ (length (union false-positive
					      false-negative
					      :test #'equalp))
			       (length all-pairs))))
	 (accuracy (- 1 error-rate)))
    
    (values accuracy
	    false-positive
	    false-negative
	    true-positive
	    true-negative)))

(defun valid-rxn-match? (meta-rxn kegg-rxn)   
  (and (with-organism (:org-id 'meta) (coercible-to-frame-p meta-rxn))
       (with-organism (:org-id 'xkegg) (coercible-to-frame-p kegg-rxn))
       (not (with-organism (:org-id 'meta)
	      (rxn-has-nad-p-or-nop? meta-rxn)))
       (not (xkegg-glycan-rxn kegg-rxn))
       (not (dissimilar-cpd-mass? meta-rxn kegg-rxn))))



;;; Cpd-related tables:

;; Generates Table 1, (tbl:cpd-comp in \LaTeX)

(defun generate-cpd-stats-table ()
  (so 'meta "16.0")
  (so 'xkegg)
  (with-organism (:org-id 'meta)
    (let* ((all-meta-cpds (cons '|Compounds|
				(mapcar #'get-frame-name
					(get-frame-all-children '|Compounds|))))	   	   
	   (kegg-cpd-instances (with-organism (:org-id 'xkegg)
				  
				 (loop for cpd in (get-class-all-instances '|Compounds|)				     
				     when (valid-xkegg-cpd-p cpd)
				     collect (get-frame-name cpd))))
	   (all-meta-cpds-in-kegg
	    (loop for cpd in all-meta-cpds
		when (get-links cpd :db 'ligand-cpd)
		collect cpd))			  
	   (metacyc-rxn-cpds
	    (loop for rxn in (all-rxns :all)
		append (get-slot-values rxn 'substrates) into all-cpds
		finally 
		  (return (mapcar #'get-frame-name
				  (remove-duplicates all-cpds :test #'fequal)))))
	   (kegg-rxn-cpds
	    (with-organism (:org-id 'xkegg)
	      (loop for rxn in (all-rxns :all)
		  when (not (xkegg-glycan-rxn rxn))
		  append (get-slot-values rxn 'substrates) into all-cpds
		  finally 
		    (return (mapcar #'get-frame-name 
				    (remove-duplicates all-cpds :test #'fequal))))))
	   (metacyc-rxn-cpds-in-kegg
	    (intersection metacyc-rxn-cpds
			  kegg-rxn-cpds))

	   (metacyc-base-pwy-rxn-cpds
	    (loop for pwy in (all-pathways :all t)
		append (loop for rxn in (reactions-of-pathway pwy)					
			   append (get-slot-values rxn 'substrates)) into all-cpds
		finally 
		  (return (mapcar #'get-frame-name
				  (remove-duplicates all-cpds :test #'fequal)))))
	   (metacyc-super-pwy-rxn-cpds
	    (loop for pwy in (all-pathways :all nil)
		append (loop for rxn in (reactions-of-pathway pwy)					
			   append (get-slot-values rxn 'substrates)) into all-cpds
		finally 
		  (return (mapcar #'get-frame-name
				  (remove-duplicates all-cpds :test #'fequal)))))
	   ;; are there any rxns in Kegg Modules that are not in Kegg Pathway Maps?
	   (kegg-map-rxn-cpds
	    (with-organism (:org-id 'xkegg)
	      (loop for rxn in (get-kegg-map-rxns)
		  append (get-slot-values rxn 'substrates) into all-cpds
		  finally 
		    (return (frame-list-to-names
			     (remove-duplicates (remove-if-not #'valid-xkegg-cpd-p
							       all-cpds) 
						:test #'fequal))))))
	   (kegg-module-rxn-cpds
	    (with-organism (:org-id 'xkegg)
	      (loop for rxn in (get-kegg-module-rxns)
		  append (get-slot-values rxn 'substrates) into all-cpds
		  finally 
		    (return (frame-list-to-names (remove-duplicates (remove-if-not #'valid-xkegg-cpd-p 
										   all-cpds) 
								    :test #'fequal))))))
	    ; (loop for cpd in metacyc-small-molecule-pwy-rxn-cpds
	    ; 	when (get-links cpd :db 'ligand-cpd)
	    ; 	collect cpd))
	   (metacyc-pwy-rxn-cpds
	    (union metacyc-base-pwy-rxn-cpds
		   metacyc-super-pwy-rxn-cpds))
	   (kegg-pwy-rxn-cpds
	    (union kegg-map-rxn-cpds
		   kegg-module-rxn-cpds))
	   (metacyc-pwy-rxn-cpds-in-kegg
	    (intersection metacyc-pwy-rxn-cpds
			  kegg-pwy-rxn-cpds)))

      
      (format t "
\\begin{tabular}{lccccccc}
\\hline
Category & M(all) & M(base) & M(super) & K(all) & K(module) & K(map) & Common  \\\\
\\hline
All chemical compounds & ~A &  &  & ~A &  & & ~A (~,2F) \\\\
All reaction substrates & ~A &  &  & ~A &  & & ~A (~,2F) \\\\
Pathway reaction substrates & ~A & ~A & ~A & ~A & ~A & ~A & ~A (~,2F) \\\\
\\hline
\\end{tabular}

"
	      ;; All chemical compounds:
	      (length all-meta-cpds)
	      (length kegg-cpd-instances)
	      (length all-meta-cpds-in-kegg)
	      (jaccard-coefficient-set (length all-meta-cpds-in-kegg)
				       (length all-meta-cpds)
				       (length kegg-cpd-instances))
	      	      
	      ;; All reaction substrates:
	      (length metacyc-rxn-cpds)
	      (length kegg-rxn-cpds)
	      (length metacyc-rxn-cpds-in-kegg)
	      (jaccard-coefficient-set (length metacyc-rxn-cpds-in-kegg)
				       (length metacyc-rxn-cpds)
				       (length kegg-rxn-cpds))
	      ;; Pathway reaction substrates: 
	      (length (union metacyc-base-pwy-rxn-cpds
			     metacyc-super-pwy-rxn-cpds))
	      (length metacyc-base-pwy-rxn-cpds)
	      (length metacyc-super-pwy-rxn-cpds)
	      (length (union kegg-map-rxn-cpds
			     kegg-module-rxn-cpds))
	      (length kegg-module-rxn-cpds)
	      (length kegg-map-rxn-cpds)
	      (length metacyc-pwy-rxn-cpds-in-kegg)
	      (jaccard-coefficient-set (length metacyc-pwy-rxn-cpds-in-kegg)
				       (length metacyc-pwy-rxn-cpds)
				       (length kegg-pwy-rxn-cpds))))))


;; Generates Table 2 (tbl:cpd-attributes in \LaTeX):

(defun generate-cpd-aspects-table ()
  (so 'meta "16.0")
  (so 'xkegg)
  (with-organism (:org-id 'meta) 
    (let* ((meta-cpd-classes (get-class-all-subs '|Compounds|))
	   (meta-cpd-instances (get-class-all-instances '|Compounds|))
	   (all-meta-cpds (union meta-cpd-classes
				 meta-cpd-instances 
				 :test #'fequal))
	   (kegg-cpd-instances
	    (with-organism (:org-id 'xkegg)
	      (loop for cpd in (get-class-all-instances '|Compounds|)
		  when (valid-xkegg-cpd-p cpd)
		  collect (get-frame-name cpd))))
	   (meta-struct-cpds
	    (loop for cpd in all-meta-cpds
		when (has-structure-p cpd)
		collect cpd))
	   (kegg-struct-cpds
	    (with-organism (:org-id 'xkegg)
	      (loop for cpd in kegg-cpd-instances
		  when (has-structure-p cpd)
		  collect (get-frame-name cpd))))
	   (meta-comment-cpds 
	    (loop for cpd in all-meta-cpds
		when (slot-has-value-p cpd 'comment)
		collect cpd))
	   (kegg-comment-cpds
	    (with-organism (:org-id 'xkegg)
	      (loop for cpd in kegg-cpd-instances
		  when (slot-has-value-p cpd 'comment)
		  collect (get-frame-name cpd))))
	   (avg-names-per-meta-cpd
	    (loop for cpd in all-meta-cpds
		sum (length (get-slot-values cpd 'names)) into all-names
		finally
		  (return (float (/ all-names 
				    (length all-meta-cpds))))))
	   (avg-names-per-kegg-cpd
	    (with-organism (:org-id 'xkegg)
	      (loop for cpd in kegg-cpd-instances
		  sum (length (get-slot-values cpd 'names)) into all-names
		  finally
		    (return (float (/ all-names 
				      (length kegg-cpd-instances)))))))
	   (avg-dblinks-per-meta-cpd
	    (loop for cpd in all-meta-cpds
		sum (length (get-links cpd)) into all-dblinks
		finally
		  (return (float (/ all-dblinks
				    (length all-meta-cpds))))))
	   (avg-dblinks-per-kegg-cpd
	    (with-organism (:org-id 'xkegg)
	      (loop for cpd in kegg-cpd-instances
		  sum (length (loop for link in (get-links cpd)
				  when (not (member (link-db link)
						    '(ligand ligand-cpd)))
				  append (tokenize-string (link-oid link)
							  :separators '(#\Space)))) into all-dblinks
		  finally
		    (return (float (/ all-dblinks 
				      (length kegg-cpd-instances)))))))
	   (avg-rxns-per-meta-cpd
	    (loop for cpd in all-meta-cpds
		sum (length (reactions-of-compound cpd)) into total-rxns
		finally
		  (return (float (/ total-rxns
				    (length all-meta-cpds))))))
	   (avg-rxns-per-kegg-cpd
	    (with-organism (:org-id 'xkegg)
	      (loop for cpd in kegg-cpd-instances
		  sum (length (reactions-of-compound cpd)) into total-rxns
		  finally
		    (return (float (/ total-rxns
				      (length kegg-cpd-instances)))))))
	   (avg-pwys-per-meta-cpd
	    (loop for cpd in all-meta-cpds
		sum (length (pathways-of-compound cpd))
		into total-pwys
		finally
		  (return (float (/ total-pwys
				    (length all-meta-cpds))))))
	   (avg-pwys-per-kegg-cpd
	    (with-organism (:org-id 'xkegg)
	      (loop for cpd in kegg-cpd-instances
		  sum (length (intersection (pathways-of-compound cpd)
					    (xkegg-non-global-pwy-instances)
					    :test #'fequal))			      
		  into total-pwys
		  finally
		    (return (float (/ total-pwys
				      (length kegg-cpd-instances)))))))
	   (avg-metacyc-comment-length
	    (loop for cpd in all-meta-cpds
		when (slot-has-value-p cpd 'comment)
		sum (length (get-slot-value cpd 'comment)) into total-length
		count it into with-comment-cpds
		finally
		  (return (float (/ total-length 
				    with-comment-cpds)))))
	   (avg-kegg-comment-length
	    (with-organism (:org-id 'xkegg)
	      (loop for cpd in kegg-cpd-instances
		  when (slot-has-value-p cpd 'comment)
		  sum (length (get-slot-value cpd 'comment)) into total-length
		  count it into with-comment-cpds
		  finally
		    (return (float (/ total-length 
				      with-comment-cpds))))))
	    (num-meta-dup-cpds
	    (loop for group in (report-duplicate-inchi-strings)
		sum (length group)))
	   (num-kegg-dup-cpds
	    (with-organism (:org-id 'xkegg)
	      (loop for group in (report-duplicate-inchi-strings)
		  sum (length group))))

	    )
      
      (format t "
\\begin{tabular}{lcc}
\\hline
 & MetaCyc & KEGG \\\\
\\hline
Compounds & ~A & ~A \\\\
Compounds with structures & ~A & ~A \\\\
Compounds with comments & ~A & ~A \\\\
Mean comment length & ~,2f & ~,2f \\\\
Mean names per compound & ~,2f & ~,2f \\\\
Mean database links per compound & ~,2f & ~,2f \\\\ 
Mean associated reactions & ~,2f & ~,2f \\\\ 
Mean associated pathways (all) per compound & ~,2f & ~,2f \\\\ 
Duplicate compounds & ~A & ~A \\\\ %% Make sure that XKeggCyc cpds have been inchi'fied. 
%% Kegg will only have 4 dups if not. Should be around 250.
\\hline
\\end{tabular}
"
	      (length all-meta-cpds)
	      (length kegg-cpd-instances)
	      (length meta-struct-cpds)
	      (length kegg-struct-cpds)
	      (length meta-comment-cpds)
	      (length kegg-comment-cpds)
	      avg-metacyc-comment-length
	      avg-kegg-comment-length
	      avg-names-per-meta-cpd
	      avg-names-per-kegg-cpd
	      avg-dblinks-per-meta-cpd
	      avg-dblinks-per-kegg-cpd
	      avg-rxns-per-meta-cpd
	      avg-rxns-per-kegg-cpd
	      avg-pwys-per-meta-cpd
	      avg-pwys-per-kegg-cpd
	      num-meta-dup-cpds
	      num-kegg-dup-cpds
	      ))))


;;; rxn-related tables:

;; Table 4 (tbl:rxn-comp in \LaTeX):

(defun generate-rxn-stats-table ()
  (so 'meta "16.0")
  (so 'xkegg)
  (with-organism (:org-id 'meta)
    (let* ((meta-rxns (mapcar #'get-frame-name (all-rxns :all)))
	   (kegg-rxns (with-organism (:org-id 'xkegg)
			(loop for rxn in (all-rxns :all)
			    when (not (xkegg-glycan-rxn rxn))
			    collect (get-frame-name rxn))))
	   (metacyc-base-pwy-rxns
	    (loop for pwy in (all-pathways :all t)
		append (reactions-of-pathway pwy) into all-rxns

		finally 
		  (return (mapcar #'get-frame-name
				  (remove-duplicates all-rxns :test #'fequal)))))
	   (metacyc-super-pwy-rxns
	    (loop for pwy in (all-pathways :all nil)
		append (reactions-of-pathway pwy) into all-rxns
						       
		finally 
		  (return (mapcar #'get-frame-name
				  (remove-duplicates all-rxns :test #'fequal)))))
	   (kegg-map-rxns
	    (get-kegg-map-rxns))
	   (kegg-module-rxns
	    (get-kegg-module-rxns))

	   )
      
      (format t "
\\begin{tabular}{lccccccc}
\\hline
Category & M(all) & M(base) & M(super) & K(all) & K(module) & K(map) & Common  \\\\
\\hline
All reactions & ~A &  &  & ~A &  & & ~A (~,2F) \\\\ 
Pathway reactions & ~A & ~A & ~A & ~A & ~A & ~A & ~A (~,2F) \\\\ 
\\hline
\\end{tabular}
"
	      (length meta-rxns)
	      (length kegg-rxns)
	      (length (intersection meta-rxns
				    kegg-rxns))
	      (jaccard-coefficient-set (length (intersection meta-rxns
							     kegg-rxns))
				       (length meta-rxns)
				       (length kegg-rxns))
	      
	      (length (union metacyc-base-pwy-rxns
			     metacyc-super-pwy-rxns
			     :test #'fequal))
	      (length metacyc-base-pwy-rxns)
	      (length metacyc-super-pwy-rxns)
	      (length (union kegg-module-rxns
			     kegg-map-rxns))
	      (length kegg-module-rxns)
	      (length kegg-map-rxns)
	      (length (intersection (frame-list-to-names (union metacyc-base-pwy-rxns
								metacyc-super-pwy-rxns
								:test #'fequal))
				    (union kegg-module-rxns
					   kegg-map-rxns)))
	      (jaccard-coefficient-set (length (intersection (frame-list-to-names (union metacyc-base-pwy-rxns
											 metacyc-super-pwy-rxns
											 :test #'fequal))
							     (union kegg-module-rxns
								    kegg-map-rxns)))
				       (length (union metacyc-base-pwy-rxns
						      metacyc-super-pwy-rxns
						      :test #'fequal))
				       (length (union kegg-module-rxns
						      kegg-map-rxns)))))))


;; Generates Table 5 (tbl:rxn-attributes in \LaTeX):

(defun generate-rxn-aspects-table ()
  (so 'meta "16.0")
  (so 'xkegg)
  (with-organism (:org-id 'meta)
    (let* (
	   (meta-rxn-instances
	    (get-class-all-instances '|Reactions|))
	   (kegg-rxn-instances
	    (with-organism (:org-id 'xkegg)
	      (get-class-all-instances '|Reactions|)))
	   ;; The following just work on instances, not classes:
	   (meta-reactions-with-comments
	    (loop for rxn in meta-rxn-instances
		when (slot-has-value-p rxn 'comment)
		collect rxn))
	   (kegg-reactions-with-comments
	    (with-organism (:org-id 'xkegg)
	      (loop for rxn in kegg-rxn-instances
	   	  when (slot-has-value-p rxn 'comment)
	   	  collect rxn)))	    
	   ;; Unbalanced rxns just uses small-molecule rxns:
	   (meta-unbalanced-rxns
	    (loop for rxn in (all-rxns :small-molecule)
		when (equal (nth-value 3 (reaction-balanced-p rxn
							      :ignore-h? t
							      :batch-mode-p t))
			    :unbalanced)
		collect rxn))
	   (kegg-unbalanced-rxns
	    (with-organism (:org-id 'xkegg)
	      (loop for rxn in (all-rxns :small-molecule)
		  when (equal (nth-value 3 (reaction-balanced-p rxn
								:ignore-h? t
								:batch-mode-p t))
			      :unbalanced)
		  collect rxn)))
	   (meta-hydrogen-unbalanced-rxns
	    (loop for rxn in (all-rxns :small-molecule)
		when (equal (nth-value 3 (reaction-balanced-p rxn
							      :ignore-h? nil
							      :batch-mode-p t))
			    :unbalanced)
		collect rxn))
	   (kegg-hydrogen-unbalanced-rxns
	    (with-organism (:org-id 'xkegg)
	      (loop for rxn in (all-rxns :small-molecule)
		  when (equal (nth-value 3 (reaction-balanced-p rxn
								:ignore-h? nil
								:batch-mode-p t))
			      :unbalanced)
		  collect rxn)))
	   (average-dblinks-per-meta-rxn
	    (loop for rxn in meta-rxn-instances
		sum (length (get-slot-values rxn 'dblinks)) into all-dblinks
		finally
		  (return (float (/ all-dblinks
				    (length meta-rxn-instances))))))
	   (average-dblinks-per-kegg-rxn
	    (with-organism (:org-id 'xkegg)
	      (loop for rxn in kegg-rxn-instances
		  sum (length (loop for link in (get-slot-values rxn 'dblinks)
				  when (not (member (link-db link)
						    '(ligand ligand-rxn)))
				  collect link)) into all-dblinks
		  finally
		    (return (float (/ all-dblinks
				      (length kegg-rxn-instances)))))))
	   (duplicate-meta-rxns
	    (loop for rxn in (all-rxns :small-molecule)
		for dupes = (remove-if #'null (first (get-duplicate-rxns rxn :exact-substrates? t)))
		when dupes
		count rxn))
	   (duplicate-kegg-rxns
	    (with-organism (:org-id 'xkegg)
	      (loop for rxn in (all-rxns :small-molecule)
		  for dupes = (remove-if #'null (first (get-duplicate-rxns rxn :exact-substrates? t)))
		  when dupes
		  count rxn)))
	   (average-pwys-per-meta-rxn
	    (loop for rxn in (all-rxns :all)
		sum (length (get-slot-values rxn 'in-pathway)) into all-pwys
		finally
		  (return (float (/ all-pwys
				    (length (all-rxns :all)))))))
	   (average-pwys-per-kegg-rxn
	    (with-organism (:org-id 'xkegg)
	      (loop for rxn in (all-rxns :all)
		  sum (length (intersection (get-slot-values rxn 'in-pathway)
					    (xkegg-non-global-pwy-instances)
					    :test #'fequal)) into all-pwys
		finally
		  (return (float (/ all-pwys
				    (length (all-rxns :all)))))))))
      
      (format t "
\\begin{tabular}{lcc}
\\hline
Category & \\MetaCyc{} & \\Kegg{} \\\\
\\hline
Reaction instances & ~A & ~A \\\\
Duplicate reactions & ~A & ~A \\\\ 
Reactions with comments & ~A & ~A \\\\
Unbalanced reactions (not counting hydrogen) & ~A & ~A \\\\
Unbalanced reactions (counting hydrogen) & ~A & ~A \\\\
Mean associated pathways & ~,2f & ~,2f \\\\
Mean database links per reaction & ~,2f & ~,2f \\\\ 
\\hline
\\end{tabular}
"
	      (length meta-rxn-instances)
	      (length kegg-rxn-instances)
	      duplicate-meta-rxns
	      duplicate-kegg-rxns	      
	      (length meta-reactions-with-comments)
	      (length kegg-reactions-with-comments)
	      (length meta-unbalanced-rxns)
	      (length kegg-unbalanced-rxns)
	      (length meta-hydrogen-unbalanced-rxns)
	      (length kegg-hydrogen-unbalanced-rxns)
	      average-pwys-per-meta-rxn
	      average-pwys-per-kegg-rxn
      	      average-dblinks-per-meta-rxn
	      average-dblinks-per-kegg-rxn
))))
		  
						 

;;; Pwy-related tables:

;; Generates Table 7 (tbl:pwy-comp in \LaTeX):

(defun generate-pwy-stats-table ()
  (so 'meta "16.0")
  (so 'xkegg)
  (with-organism (:org-id 'meta)
    (let* ((meta-base (base-pathways)) ;; For metacyc 16.0, no need to exclude signaling pathways (they don't exist) taltman:Jun-1-2012 
	   (meta-super (get-class-all-instances '|Super-Pathways|))
	   (kegg-maps (all-kegg-maps))
	   (kegg-modules (all-kegg-modules))
	   (meta-base-avg-rxns  (/ (loop for p in meta-base
				       sum (length (reactions-of-pathway p)))
				   (length meta-base)))
	   (meta-super-avg-rxns (/ (loop for p in meta-super 
				       sum (length (reactions-of-pathway p))) 
				   (length meta-super)))
	   (kegg-modules-avg-rxns (/ (with-organism (:org-id 'xkegg)
				       (loop for p in kegg-modules 
					   sum (length (reactions-of-kegg-module p))) )
				     (length kegg-modules)))
	   (kegg-maps-avg-rxns (/ (with-organism (:org-id 'xkegg)
				    (loop for p in kegg-maps 
					sum (length (reactions-of-kegg-map p))) )
				  (length kegg-maps)))
	   (meta-base-avg-cpds  (/ (loop for p in meta-base 
				       sum (length (compounds-of-pathway p))) 
				   (length meta-base)))
	   (meta-super-avg-cpds (/ (loop for p in meta-super
				       sum (length (compounds-of-pathway p))) 
				   (length meta-super)))
	   (kegg-modules-avg-cpds (/ (with-organism (:org-id 'xkegg)
				       (loop for p in kegg-modules
					   sum (length (compounds-of-kegg-module p))) )
				     (length kegg-modules)))
	   (kegg-maps-avg-cpds (/ (with-organism (:org-id 'xkegg)
				    (loop for p in kegg-maps
					sum (length (compounds-of-kegg-map p))))
				  (length kegg-maps))) 
	   )
      
      (format t "
\\begin{table}
\\begin{tabular}{cccc}
\\hline
Category & M(base) &  K(module) & M(super) & K(map) \\\\
\\hline
Pathways & ~A & ~A & ~A & ~A\\\\ 
Mean reactions per pathway & ~,2F & ~,2F & ~,2F & ~,2F\\\\ 
Mean compounds per pathway & ~,2F & ~,2F & ~,2F & ~,2F\\\\ 
\\hline
\\end{tabular}
\\caption{Comparison of metabolic pathways in MetaCyc
and KEGG.\\label{tbl:pwy-comp}}
\\end{table}"
	      (length meta-base)
	      (length kegg-modules)
	      (length meta-super)
	      (length kegg-maps)
	      
	      (float meta-base-avg-rxns)
	      (float kegg-modules-avg-rxns)
	      (float meta-super-avg-rxns)
	      (float kegg-maps-avg-rxns)

	      meta-base-avg-cpds
	      kegg-modules-avg-cpds
	      meta-super-avg-cpds
	      kegg-maps-avg-cpds
	      ))))


;; Generates Table 8 (tbl:pwy-attributes in \LaTeX):

(defun generate-pwy-aspects-table ()
  (so 'meta "16.0")
  (so 'xkegg)
  (with-organism (:org-id 'meta)
    (let* ((meta-pwy-classes
	    (get-class-all-subs '|Pathways|))
	   (meta-pwy-instances
	    (get-class-all-instances '|Pathways|))
	   (kegg-pwy-classes
	    (with-organism (:org-id 'xkegg)
	      (frame-list-to-names (append (get-class-all-subs '|Pathway-Maps|)
					   (get-class-all-subs '|Modules|)))))
	   (kegg-pwy-instances
	      (xkegg-non-global-pwy-instances))
	   ;; The following just work on instances, not classes:
	   (meta-pwys-with-comments
	    (loop for pwy in meta-pwy-instances
		when (slot-has-value-p pwy 'comment)
		collect pwy))
	   (kegg-pwys-with-comments
	    (with-organism (:org-id 'xkegg)
	      (loop for pwy in kegg-pwy-instances
		  when (slot-has-value-p pwy 'comment)
		  collect pwy)))
	   (average-meta-pathway-comment-length
	    (loop for pwy in meta-pwy-instances
		sum (length (get-slot-value pwy 'comment)) into all-comments
		finally
		  (return (float (/ all-comments
				    (length meta-pwy-instances))))))
	   (average-kegg-pathway-comment-length
	    (with-organism (:org-id 'xkegg)
	      (loop for pwy in kegg-pwy-instances
		sum (length (get-slot-value pwy 'comment)) into all-comments
		finally
		  (return (float (/ all-comments
				    (length kegg-pwy-instances)))))))
	   (average-dblinks-per-meta-pwy
	    (loop for pwy in meta-pwy-instances
		sum (length (get-slot-values pwy 'dblinks)) into all-dblinks
		finally
		  (return (float (/ all-dblinks
				    (length meta-pwy-instances))))))
	   (average-dblinks-per-kegg-pwy
	    (with-organism (:org-id 'xkegg)
	      (loop for pwy in kegg-pwy-instances
		  sum (length (loop for link in (get-slot-values pwy 'dblinks)
				  when (not (eql (link-db link) 'ligand))
				  append (tokenize-string (link-oid link)
							  :separators '(#\Space)))) into all-dblinks
		  finally
		    (return (float (/ all-dblinks
				      (length kegg-pwy-instances)))))))
	   (average-rxns-per-meta-pwy
	    (loop for pwy in meta-pwy-instances
		sum (length (reactions-of-pathway pwy)) into all-rxns
		finally
		  (return (float (/ all-rxns
				    (length meta-pwy-instances))))))
	   (average-rxns-per-kegg-pwy
	    (with-organism (:org-id 'xkegg)
	      (loop for pwy in kegg-pwy-instances
		  sum (length (reactions-of-pathway pwy)) into all-rxns
		  finally
		    (return (float (/ all-rxns
				      (length kegg-pwy-instances))))))))
      
      (format t "
\\begin{tabular}{lcc}
\\hline
Category & \\MetaCyc{} & \\Kegg{} \\\\
\\hline
Pathway classes & ~A & ~A \\\\
Pathway instances & ~A & ~A \\\\
Pathways with comments & ~A & ~A \\\\
Comment length & ~,1f & ~,1f \\\\
DB links  & ~,2f & ~,2f \\\\ 
Reactions per pathway & ~,2f & ~,2f \\\\
\\hline
\\end{tabular}
"
	      (length meta-pwy-classes)
	      (length kegg-pwy-classes)
	      (length meta-pwy-instances)
	      (length kegg-pwy-instances)
	      (length meta-pwys-with-comments)
	      (length kegg-pwys-with-comments)
	      average-meta-pathway-comment-length
	      average-kegg-pathway-comment-length
      	      average-dblinks-per-meta-pwy
	      average-dblinks-per-kegg-pwy	      
	      average-rxns-per-meta-pwy
	      average-rxns-per-kegg-pwy
))))


;; Try to map metacyc base pathways to kegg modules.
;; If at least Fraction rxns match between the two pathways then we say the pathways match.
(defun metacyc-pwy-matches-kegg-module (pwy &key (fraction 0.75))
  (with-organism (:org-id 'xkegg)
    (let* ((m-rxns (frame-list-to-names (reactions-of-pathway pwy)))
	   )
      (loop for mod in (all-kegg-modules)
	  for kegg-rxns = (reactions-of-kegg-module mod)
	  for overlap = (intersection kegg-rxns m-rxns)
	  ;;do (print m-rxns) (print kegg-rxns)
	  when (<= fraction (/ (float (length overlap)) (float (length m-rxns))))
	  collect mod)
      ) ) )



;; The following two functions are used for generating Table 10 (tbl:pwy-coverage in \LaTeX):

;; Assess degree to which metacyc pathways cover rxns in kegg
;; Returns seven values that indicate metacyc pwys with high coverage, partial coverage, and little coverage.
;; A pathway has high coverage if more than (1- Cutoff) of its reactions
;; contain links to rxns in KEGG -- note we do not require that those
;; KEGG rxns are in pathways.
;; taltman:Jun-1-2012 pwy-type is either 'base or 'super
(defun metacyc-pathway-kegg-coverage (&optional (pwy-type 'base) &key (cutoff 0.0))
  (so 'xkegg)
  (so 'meta "16.0")
  (loop for pwy in (if (eql pwy-type 'base)
		       (base-pathways);; For metacyc 16.0, no need to exclude signaling pathways (they don't exist) taltman:Jun-1-2012 
		     (get-class-all-instances '|Super-Pathways|))
	for rxns = (get-slot-values pwy 'reaction-list)
	for num-linked-rxns = (loop for rxn in rxns
				    when (get-links rxn :db 'ligand-rxn)
				    count rxn)
	for frac-linked = (when rxns
			    (/ num-linked-rxns
			       (length rxns))
			    )
	if (>= frac-linked (- 1.0 cutoff))
	collect pwy into most-coverage
	else if (<= frac-linked cutoff)
	collect pwy into little-coverage
	else if (null frac-linked)
	collect pwy into pwys-with-no-coverage
	else 
	collect pwy into partial-coverage
	finally
	;; Store in globals for access by the programmer
	(setq *metacyc-most-coverage* most-coverage
	      *metacyc-partial-coverage* partial-coverage
	      *metacyc-little-coverage* little-coverage
	      *metacyc-pwys-with-no-coverage* pwys-with-no-coverage
	      )
	(return
	 (values
	  most-coverage
	  partial-coverage
	  little-coverage          ;; If cutoff=0.0 this value will be pwys unique to MetaCyc; else this value is pwys <= cutoff
	  pwys-with-no-coverage    ;; If cutoff=0.0 this value will be NIL; else this value will list pwys unique to MetaCyc
	  (length most-coverage)
	  (length partial-coverage)
	  (length little-coverage)
	  ))))

#||
(kegg-pathway-metacyc-coverage nil)
(kegg-pathway-metacyc-coverage t)
||#

;; Assess degree to which kegg pathways cover rxns in metacyc.
;; Arg Maps? indicates whether we consider maps or modules.
;; taltman:Jun-1-2012 Fixed counting bug re: empty pathways

(defun kegg-pathway-metacyc-coverage (maps? &key (cutoff 0.0))
  (with-organism (:org-id 'xkegg)
    (loop for pwy in (if maps? (all-kegg-maps) (all-kegg-modules))
	  for rxns = (if maps? (reactions-of-kegg-map pwy) (reactions-of-kegg-module pwy))
	  for num-linked-rxns = (loop for rxn in rxns
				      for rxn-name = (get-frame-name rxn)
				      when (with-organism (:org-id 'meta)
							  (coercible-to-frame-p rxn-name))
				      count rxn)
	  for frac-linked = (if rxns
				(/ num-linked-rxns
				   (length rxns))
			      :NO-REACTIONS)
	  if (eq :NO-REACTIONS frac-linked)
	  collect pwy into empty-pathways
	  else if (>= frac-linked (- 1.0 cutoff))
	  collect pwy into most-coverage
	  else if (<= frac-linked cutoff)
	  collect pwy into little-coverage
			   ;; this clause is never used due to interaction with first clause:
	else if (null frac-linked)
	  collect pwy into pwys-with-no-coverage
	  else 
	  collect pwy into partial-coverage
	  finally
	  ;; Store in globals for access by the programmer
	  (setq *kegg-most-coverage* most-coverage
		*kegg-partial-coverage* partial-coverage
		*kegg-little-coverage* little-coverage
		*kegg-pwys-with-no-coverage* empty-pathways
		)
	  (return (values most-coverage
			  partial-coverage
			  little-coverage
			  pwys-with-no-coverage
			  (length most-coverage)
			  (length partial-coverage)
			  (length little-coverage)
			  (length empty-pathways)
			  )))))


;; This fn computes which rxns in MetaCyc and KEGG pathways are unique to
;; the respective databases.

(defun unique-pwy-rxns ()
  (with-organism (:org-id 'meta)
    (format t "MetaCyc pathways cover ~A reactions not found in KEGG~%"
	    (loop for r in (fremove-duplicates (loop for p in (base-pathways) append (get-slot-values p 'reaction-list)))
		count (null (get-links r :db 'ligand-rxn)) ) )
			
    )
  (with-organism (:org-id 'xkegg)
    (format t "KEGG pathways cover ~A reactions not found in MetaCyc~%"
	    (loop for r in (fremove-duplicates (loop for p in (all-kegg-maps) append (get-slot-values p 'reaction-list)))
		  count (not (coercible-to-frame-p (frname r) :kb (metacyc-kb)) ) ) )
		 )
  )


;; Returns all modules not within at least one map:
(defun modules-not-within-maps ()
  (with-organism (:org-id 'xkegg)
    (loop for module in (get-class-all-instances '|Modules|)
	for related-maps = (loop for rxn in (get-slot-values module 'reaction-list)
			       append (loop for pwy in (get-slot-values rxn 'in-pathway)
					  when (and (not (fequal pwy module))
						    (all-child-of-p pwy '|Pathway-Maps|))
					  collect pwy))
	for containing-maps = (loop for map in related-maps
				  when (null (set-difference (get-slot-values module 'reaction-list) 
							     (get-slot-values map 'reaction-list)
							     :test #'fequal))
				  collect map)
			      
	when (null containing-maps)
	collect module)))


;; These two functions are used to quantify how many Kegg pathways have information analogous 
;; to the MetaCyc concept of reaction predecessors (see definition of predecessor slot). Such
;; equivalent information is stored in the "ECrel" relation, as found in KGML and via the KEGG 
;; SOAP API (see the get-element-reations-by-pathway function):

(defun check-kegg-pwys-for-relations (pwys)
  (loop for pwy in pwys
      for pwy-string = (concatenate 'string
				     "path:"
				     (excl:replace-re (symbol-name (get-frame-name pwy))
					"KEGG-map"
					"ko"))
      for pwy-relations = (kegg::get-element-relations-by-pathway :pathway_id pwy-string)

      do (format t "~A~%" pwy-string)			  
      when (kegg-pathway-relations-have-ecrel pwy-relations)
      collect pwy))

(defun kegg-pathway-relations-have-ecrel (relations-sexpr)
  (let ((relations (second (second relations-sexpr))))
    (loop for relation across relations
	for flat-relation = (flatten-list relation)
	thereis (member "ECrel" flat-relation
			:test  #'equalp))))


;;; Enrichment/Depletion Analysis of MetaCyc and KEGG

;; Pathways that are statistically enriched/depleted (pvalue <= 10^-3) for rxns with links to Kegg rxns:

;; Utility function to convert pathway frame into name suitable for inclusion in \LaTeX source file:
(defun format-pathway-name (pwy)
  (let ((initial-name (or (get-slot-value pwy 'common-name)
			  (symbol-name (get-frame-name pwy)))))
    
    (excl:replace-re (excl:replace-re (string-capitalize (substitute #\Space #\- (excl:replace-re (excl:replace-re initial-name "\<\/?sub\>" "")
												  "\<\/?i\>" "")))
				      "Co2"
				      "CO$_2$")
		     "Nad"
		     "NAD")))


;; Function used for generating Tables 11 and 12 (tbl:sig-meta-pwy-class and tbl:sig-kegg-pwy class in \LaTeX) p-value is the threshold for significance (i.e., only pvalues smaller than the provided value will be included in the output):

(defun print-enrichment-depletion-tables (p-value &key (correction-method #'stat::bonferroni-correction))
  
  (so 'meta "16.0")
  
  (let* ((linked-rxns (with-organism (:org-id 'xkegg)
			(loop for rxn in (get-class-all-instances '|Reactions|) 
			    for rxn-name = (get-frame-name rxn) 
			    when (with-organism (:org-id 'meta) 
				   (coercible-to-frame-p rxn-name)) 
			    collect rxn-name)))
	 (meta-unlinked-rxns (set-difference (frame-list-to-names (all-rxns :small-molecule))
					     linked-rxns))
	 (kegg-unlinked-rxns (with-organism (:org-id 'xkegg)
			       (set-difference (frame-list-to-names (all-rxns :small-molecule))
					       linked-rxns)))

	 ;; MetaCyc Enrichment/Depletion
	 (metacyc-enriched-pwys
	  (with-organism (:org-id 'meta)
	    (multiple-value-bind (terms problem) 
		(make-pathway-reaction-problem (all-rxns :small-molecule) 
					       linked-rxns)
	      (enrichment problem terms :term-for-term p-value
			  :type :enrichment 
			  :enrichment-statistic :fisher-exact 
			  :multiple-hypothesis-correction-fn correction-method))))
	  
	 (metacyc-enriched-pwy-classes
	    (loop for (pwy pvalue) in metacyc-enriched-pwys
		when (and (class-p pwy)
			  (not (fequal pwy '|Pathways|)))
		collect (list (get-frame-name pwy)
			      "Enriched"
			      (format-pathway-name pwy) 
			      (length (get-class-all-instances pwy))
			      pvalue)))

	 (metacyc-depleted-pwys
	  (with-organism (:org-id 'meta)
	    (multiple-value-bind (terms problem) 
		(make-pathway-reaction-problem (all-rxns :small-molecule) 
					       meta-unlinked-rxns)
	      (enrichment problem terms :term-for-term p-value
			  :type :enrichment 
			  :enrichment-statistic :fisher-exact 
			  :multiple-hypothesis-correction-fn correction-method))))
	 (metacyc-depleted-pwy-classes
	    (loop for (pwy pvalue) in metacyc-depleted-pwys
		when (and (class-p pwy)
			  (not (fequal pwy '|Pathways|)))
		collect (list (get-frame-name pwy)
			      "Depleted" 
			      (format-pathway-name pwy) 
			      (length (get-class-all-instances pwy))
			      pvalue)))

	 (kegg-enriched-pwys
	  (with-organism (:org-id 'xkegg)
	    (loop for (pwy pvalue) in (multiple-value-bind (terms problem) 
					  (make-pathway-reaction-problem (all-rxns :small-molecule) 
									 linked-rxns) 
					(enrichment problem terms :term-for-term p-value
						    :type :enrichment 
						    :enrichment-statistic :fisher-exact 
						    :multiple-hypothesis-correction-fn correction-method))
		when (and (class-p pwy)
			  (not (member pwy '(|Pathways| |Modules| |Pathway-Maps|)
				       :test #'fequal)))
		collect (list (get-frame-name pwy)
			      "Enriched" 
			      (format-pathway-name pwy)
			      (length (get-class-all-instances pwy))
			      pvalue))))
	 (kegg-depleted-pwys
	  (with-organism (:org-id 'xkegg)
	    (loop for (pwy pvalue) in (multiple-value-bind (terms problem) 
					  (make-pathway-reaction-problem (all-rxns :small-molecule) 
									 kegg-unlinked-rxns) 
					(enrichment problem terms :term-for-term p-value
						    :type :enrichment 
						    :enrichment-statistic :fisher-exact 
						    :multiple-hypothesis-correction-fn correction-method))
		when (and (class-p pwy)
			  (not (member pwy '(|Pathways| |Modules| |Pathway-Maps|)
				       :test #'fequal)))
		collect (list (get-frame-name pwy)
			      "Depleted" 
			      (format-pathway-name pwy) 
			      (length (get-class-all-instances pwy))
			      pvalue)))))

    ;; Print MetaCyc table:
    (format t "MetaCyc table: ~%")
    (loop for (pwy-frame status pwy class-size pvalue) in metacyc-enriched-pwy-classes
	for pvalue-str = (substitute #\e #\d (format nil "~,1G" pvalue))
	for pvalue-tex-str = (concatenate 'string
			       "$"
			       (subseq pvalue-str 0 3)
			       " \\times 10^{"
			       (subseq pvalue-str 4)
			       "}$")
	for pwy-class-rxns = (loop for pwy-inst in (get-class-all-instances pwy-frame)
				 append (frame-list-to-names (reactions-of-pathway pwy-inst)) into all-rxns
				 finally
				   (return (remove-duplicates all-rxns)))
	for pwy-class-linked-rxns = (intersection pwy-class-rxns 
						  linked-rxns)

	when (not (member pwy '("Pathways")
			  :test #'string=))
	do (format t "~A & ~A & ~A & $\\sfrac{~A}{~A}$ & ~A \\\\~%"
		   status
		   pwy
		   class-size
		   (length pwy-class-linked-rxns)
		   (length pwy-class-rxns)
		   pvalue-tex-str))
    (format t "\\hline~%")
        (loop for (pwy-frame status pwy class-size pvalue) in metacyc-depleted-pwy-classes
	for pvalue-str = (substitute #\e #\d (format nil "~,1G" pvalue))
	for pvalue-tex-str = (concatenate 'string
			       "$"
			       (subseq pvalue-str 0 3)
			       " \\times 10^{"
			       (subseq pvalue-str 4)
			       "}$")
	for pwy-class-rxns = (loop for pwy-inst in (get-class-all-instances pwy-frame)
				 append (frame-list-to-names (reactions-of-pathway pwy-inst)) into all-rxns
				 finally
				   (return (remove-duplicates all-rxns)))
	for pwy-class-linked-rxns = (intersection pwy-class-rxns 
						  linked-rxns)

	when (not (member pwy '("Pathways")
			  :test #'string=))
	do (format t "~A & ~A & ~A & $\\sfrac{~A}{~A}$ & ~A \\\\~%"
		   status
		   pwy
		   class-size
		   (length pwy-class-linked-rxns)
		   (length pwy-class-rxns)
		   pvalue-tex-str))


    
    (format t "~%KEGG table: ~%")
    
     ;; Print Kegg table:
    (loop for (pwy-frame status pwy class-size pvalue) in kegg-enriched-pwys
	for pvalue-str = (substitute #\e #\d (format nil "~,1G" pvalue))
	for pvalue-tex-str = (concatenate 'string
			       "$"
			       (subseq pvalue-str 0 3)
			       " \\times 10^{"
			       (subseq pvalue-str 4)
			       "}$")
	for pwy-class-rxns = (with-organism (:org-id 'xkegg)
			       (loop for pwy-inst in (get-class-all-instances pwy-frame)
				   append (frame-list-to-names (reactions-of-pathway pwy-inst)) into all-rxns
				   finally
				     (return (remove-duplicates all-rxns))))
	for pwy-class-linked-rxns = (intersection pwy-class-rxns 
						  linked-rxns)				    
	;;for pwy-str = (substitute #\Space #\- (excl:replace-re pwy "\<\/?i\>" ""))
	when (not (member pwy '("Modules" "Pathway Module" "Structural Complex" "1640" "Metabolism" "Pathways" "Pathway Maps")
			  :test #'string=))
	do (format t "~A & ~A & ~A &  $\\sfrac{~A}{~A}$ & ~A \\\\~%"
		   status
		   pwy
		   class-size
		   (length pwy-class-linked-rxns)
		   (length pwy-class-rxns)		   
		   pvalue-tex-str))
    (format t "\\hline~%")
    (loop for (pwy-frame status pwy class-size pvalue) in kegg-depleted-pwys
	for pvalue-str = (substitute #\e #\d (format nil "~,1G" pvalue))
	for pvalue-tex-str = (concatenate 'string
			       "$"
			       (subseq pvalue-str 0 3)
			       " \\times 10^{"
			       (subseq pvalue-str 4)
			       "}$")
	for pwy-class-rxns = (with-organism (:org-id 'xkegg)
			       (loop for pwy-inst in (get-class-all-instances pwy-frame)
				   append (frame-list-to-names (reactions-of-pathway pwy-inst)) into all-rxns
				   finally
				     (return (remove-duplicates all-rxns))))
	for pwy-class-linked-rxns = (intersection pwy-class-rxns 
						  linked-rxns)				    
	;;for pwy-str = (substitute #\Space #\- (excl:replace-re pwy "\<\/?i\>" ""))
	when (not (member pwy '("Modules" "Pathway Module" "Structural Complex" "1640" "Metabolism" "Pathways" "Pathway Maps")
			  :test #'string=))
	do (format t "~A & ~A & ~A &  $\\sfrac{~A}{~A}$ & ~A \\\\~%"
		   status
		   pwy
		   class-size
		   (length pwy-class-linked-rxns)
		   (length pwy-class-rxns)		   
		   pvalue-tex-str))))


;; Function for generating output included in the 'supp_matl.xls' file in the Supplementary Materials. Definition of the p-value argument is the same as the previous function.

(defun print-supplementary-materials-enrichment-tables (p-value &key (correction-method #'stat::bonferroni-correction))
  (so 'meta "16.0")
  
  (let* ((linked-rxns (with-organism (:org-id 'xkegg)
			(loop for rxn in (gcai '|Reactions|) 
			    for rxn-name = (get-frame-name rxn) 
			    when (with-organism (:org-id 'meta) 
				   (coercible-to-frame-p rxn-name)) 
			    collect rxn-name)))
	 (meta-unlinked-rxns (set-difference (frame-list-to-names (all-rxns :small-molecule))
					     linked-rxns))
	 (kegg-unlinked-rxns (with-organism (:org-id 'xkegg)
			       (set-difference (frame-list-to-names (all-rxns :small-molecule))
					       linked-rxns)))
	 ;; MetaCyc Enrichment/Depletion
	 (metacyc-enriched-pwys
	  (with-organism (:org-id 'meta)
	    (loop for (pwy pvalue) in 
		  (multiple-value-bind (terms problem) 
		      (make-pathway-reaction-problem (all-rxns :small-molecule) 
						     linked-rxns) 
		    (enrichment problem terms :term-for-term p-value
				:type :enrichment 
				:enrichment-statistic :fisher-exact 
				:multiple-hypothesis-correction-fn correction-method))
		when (and (class-p pwy)
			  (not (fequal pwy '|Pathways|)))
		collect (list (get-frame-name pwy) "Enriched" pvalue))))
	 (metacyc-depleted-pwys
	  (with-organism (:org-id 'meta)
	    (loop for (pwy pvalue) in 
		  (multiple-value-bind (terms problem) 
		      (make-pathway-reaction-problem (all-rxns :small-molecule) 
						     meta-unlinked-rxns) 
		    (enrichment problem terms :term-for-term p-value
				:type :enrichment 
				:enrichment-statistic :fisher-exact 
				:multiple-hypothesis-correction-fn correction-method))
		when (and (class-p pwy)
			  (not (fequal pwy '|Pathways|)))
		collect (list (get-frame-name pwy) "Depleted" pvalue))))
	 (kegg-enriched-pwys
	  (with-organism (:org-id 'xkegg)
	    (loop for (pwy pvalue) in (multiple-value-bind (terms problem) 
	 				  (make-pathway-reaction-problem (all-rxns :small-molecule) 
	 								 linked-rxns) 
	 				(enrichment problem terms :term-for-term p-value
	 					    :type :enrichment 
	 					    :enrichment-statistic :fisher-exact 
	 					    :multiple-hypothesis-correction-fn correction-method))
	 	when (and (class-p pwy)
			  (not (member '(|Pathways| |Modules| |Pathway-Maps|)
				       :test #'fequal)))
	 	collect (list (get-frame-name pwy) "Enriched" pvalue))))
	 (kegg-depleted-pwys
	  (with-organism (:org-id 'xkegg)
	    (loop for (pwy pvalue) in (multiple-value-bind (terms problem) 
	 				  (make-pathway-reaction-problem (all-rxns :small-molecule) 
	 								 kegg-unlinked-rxns) 
	 				(enrichment problem terms :term-for-term p-value
	 					    :type :enrichment 
	 					    :enrichment-statistic :fisher-exact 
	 					    :multiple-hypothesis-correction-fn correction-method))
	 	when (and (class-p pwy)
			  (not (member pwy '(|Pathways| |Modules| |Pathway-Maps|)
				       :test #'fequal)))
		collect (list (get-frame-name pwy) "Depleted" pvalue)))))
    
    (format t "MetaCyc table:~%~%")
    (loop for (pwy (enrich deplete)) in (lisputils::merge-alist metacyc-enriched-pwys
								metacyc-depleted-pwys
								#'list)
	for pwy-name = (format-pathway-name pwy)
	for num-pwys = (length (get-class-all-instances pwy))
	for pwy-class-rxns = (loop for pwy-inst in (get-class-all-instances pwy)
				 append (frame-list-to-names (reactions-of-pathway pwy-inst)) into all-rxns
				 finally
				   (return (remove-duplicates all-rxns)))
	for enrich-pvalue-str = (substitute #\e #\d (format nil "~,1G" (third enrich)))
	for deplete-pvalue-str = (substitute #\e #\d (format nil "~,1G" (third deplete)))
	for pwy-linked-rxns = (intersection pwy-class-rxns linked-rxns)
	for fraction-linked-rxns = (when (> (length pwy-class-rxns) 0)
				     (substitute #\e #\d (format nil "~,2F" (float (* 100 
										      (/ (length pwy-linked-rxns)
											 (length pwy-class-rxns)))))))

	when (> (length pwy-class-rxns) 0)
	do (format t "~A~C~A~C~A~C~A~C~A~C~A~C~A~C~A~%"
		   pwy
		   #\Tab
		   pwy-name
		   #\Tab
		   num-pwys
		   #\Tab
		   (length pwy-class-rxns)
		   #\Tab
		   (length pwy-linked-rxns)
		   #\Tab
		   fraction-linked-rxns
		   #\Tab
		   enrich-pvalue-str
		   #\Tab
		   deplete-pvalue-str))
    
    (format t "KEGG table: ~%~%")
    (with-organism (:org-id 'xkegg)
      (loop for (pwy (enrich deplete)) in (lisputils::merge-alist kegg-enriched-pwys
								  kegg-depleted-pwys
								  #'list)
	  for pwy-name = (format-pathway-name pwy)
	  for num-pwys = (length (get-class-all-instances pwy))
	  for pwy-class-rxns = (loop for pwy-inst in (get-class-all-instances pwy)
				   append (frame-list-to-names (reactions-of-pathway pwy-inst)) into all-rxns
				   finally
				     (return (remove-duplicates all-rxns)))
	  for enrich-pvalue-str = (substitute #\e #\d (format nil "~,1G" (third enrich)))
	  for deplete-pvalue-str = (substitute #\e #\d (format nil "~,1G" (third deplete)))
	  for pwy-linked-rxns = (intersection pwy-class-rxns linked-rxns)
	  for fraction-linked-rxns = (when (> (length pwy-class-rxns) 0)
				       (substitute #\e #\d (format nil "~,2F" (float (* 100 
											(/ (length pwy-linked-rxns)
											   (length pwy-class-rxns)))))))
				     
	  when (> (length pwy-class-rxns) 0)
	  do (format t "~A~C~A~C~A~C~A~C~A~C~A~C~A~C~A~%"
		     pwy
		     #\Tab
		     pwy-name
		     #\Tab
		     num-pwys
		     #\Tab
		     (length pwy-class-rxns)
		     #\Tab
		     (length pwy-linked-rxns)
		     #\Tab
		     fraction-linked-rxns
		     #\Tab
		     enrich-pvalue-str
		     #\Tab
		     deplete-pvalue-str)))))


;;; Taxonomic analysis
;; The following functions are used for generating Table 13 (tbl:taxa in \LaTeX):

;; Return all taxa of the given reaction:
(defun taxa-of-reaction (rxn)
  (so 'meta "16.0")
  (loop for pwy in (pathways-of-reaction rxn)
      append (get-slot-values pwy 'taxonomic-range) into taxa
      finally
	(return (frame-list-to-names (remove-duplicates taxa :test #'fequal)))))


;; Report fractions of pathway class reactions that are linked to KEGG reactions:

(defun metacyc-linked-rxns-by-taxon (&key (magic-pwy-threshold 50)
					  (magic-kegg-pwy-threshold 0.75)
					  (pwy-type :base))
  (so 'meta "16.0")
  (let* ((pathways (if (eq pwy-type :base)
		       (base-pathways)
		     (get-class-all-instances '|Pathways|)))
	 
	 (taxa-of-pwys (loop for pwy in pathways
			   append (get-slot-values pwy 'taxonomic-range) into taxa
			   finally
			     (return (remove-duplicates taxa 
							:test #'fequal)))))
    
    (loop for taxon in taxa-of-pwys
	for i = 1 then (+ i 1)
	for pathways-of-taxon = (loop for pwy in pathways
				     when (loop for tr in (get-slot-values pwy 'taxonomic-range)
					      thereis (or (fequal tr taxon)
							  (all-child-of-p tr taxon)))
				     collect pwy)
				 
	for linked-kegg-pwys = (loop for pwy in pathways-of-taxon
				   when (metacyc-pwy-to-xkegg-pwy pwy :threshold magic-kegg-pwy-threshold)
				   collect it)
       
				
	do (format t "Processing taxon ~A (~A of ~A)~%"
		   (get-slot-value taxon 'common-name)
		   i
		   (length taxa-of-pwys))
	   
	when (>= (length pathways-of-taxon)
		 magic-pwy-threshold)
	collect (list (get-frame-name taxon)
		      (length pathways-of-taxon)
		      (length linked-kegg-pwys)
		      (float (/ (length linked-kegg-pwys)
				(length pathways-of-taxon)))) into taxa
							
	finally
	  (return (sort taxa #'> :key #'fourth)))))

(defun print-taxonomy-abundance-table ( &key (abundances (metacyc-linked-rxns-by-taxon)))
    
    (loop for (taxon
	       num-pwys
	       num-linked-pwys
	       frac-linked) in (reverse abundances)
			       
	do (format t "~A & ~A & ~A & ~A & ~A & ~,1F \\\\~%"
		   (link-oid (first (get-links taxon :db 'ncbi-taxonomy-db)))
		   (get-slot-value taxon 'common-name)
		   (first (get-slot-values taxon 'synonyms))
		   num-pwys
		   (- num-pwys num-linked-pwys)
		   (- 100 (* 100 frac-linked)))))

;; Prototyping the correct analyses by using Viridiplantae (TAX-33090) as an example:

(defun all-green-plant-pathways ()
  (so 'meta "16.0")
  (loop for pwy in (get-class-all-instances '|Pathways|) 
      when (loop for tax in (get-slot-values pwy 'taxonomic-range) 
	       thereis (or (fequal tax 'TAX-33090) 
			   (all-child-of-p tax 'Tax-33090))) 
      collect pwy))

(defun rank-green-plant-pathways-by-kegg-links ()
  (loop for pwy in (all-green-plant-pathways)
      for linked-rxns = (metacyc-rxns-linked-to-xkegg (get-slot-values pwy 'reaction-list))
      collect (list (get-frame-name pwy)
		    (length (get-slot-values pwy 'reaction-list))
		    (length linked-rxns)
		    (float (/ (length linked-rxns)
			      (length (get-slot-values pwy 'reaction-list))))) into linked-pwys
      finally
	(return (sort linked-pwys 
		      #'>
		      :key #'third))))

;; So, for example, PWY-699 has 21 out of 22 pathways linked.

;; For a MetaCyc pwy, find all KEGG pwys that are linked by a shared reaction. Rank the resulting list of KEGG pwys by the number of shared reactions.
;; This function is used to determine the "non-unique" MetaCyc pathways, and thus the "unique pathways" reported in Table 13:

(defun metacyc-pwy-to-xkegg-pwy (meta-pwy &key (threshold 0.75))
  (let* ((linked-pwy-rxns (metacyc-rxns-linked-to-xkegg (get-slot-values meta-pwy 'reaction-list)))
	 (kegg-pwy-rxn-hash (make-hash-table)))
	  	  
    (with-organism (:org-id 'xkegg)
      (loop for rxn in linked-pwy-rxns
	  when (coercible-to-frame-p rxn)
	  do (loop for pwy in (get-slot-values rxn 'in-pathway) 
		 when (member pwy (xkegg-non-global-pwy-instances) :test #'fequal)
		 do (push (get-frame-name rxn)
			  (gethash (get-frame-name pwy)
				   kegg-pwy-rxn-hash)))))
    
    (loop for kegg-pwy being the hash-keys in kegg-pwy-rxn-hash using (hash-value v)
	for kegg-matched-rxns = (remove-duplicates v)
	when (>= (/ (length kegg-matched-rxns)
		    (length (get-slot-values meta-pwy 'reaction-list)))
		 threshold)
	collect (list kegg-pwy (length kegg-matched-rxns)) into ranked-pwys
	finally
	  (return (sort ranked-pwys #'> :key #'second)))))



;;; Histogram of # of Reactions per Pathway for Kegg & MetaCyc
;; This code will output the raw tables that will be processed in R to generate the histogram plots:
;; I.e., Figures 1 and 2 in the paper (fig:rxn-pwy-base-modue and fig:rxn-pwy-super-map in \LaTeX)

(defun output-rxn-per-pwy-table ()
  (format t "Source~CNumber Rxns~Cfill~%" #\Tab #\Tab)
  (loop for (pwy source num-rxns color) in (append 
				      (loop for pwy in (base-pathways) ;; For metacyc 16.0, no need to exclude signaling pathways (they don't exist) taltman:Jun-1-2012 
					  collect (list (get-frame-name pwy) "MetaCyc Base Pathways" (length (reactions-of-pathway pwy))
							"blue"))
				      (loop for pwy in (get-class-all-instances '|Super-Pathways|)
					  collect (list (get-frame-name pwy) "MetaCyc Super Pathways" (length (reactions-of-pathway pwy)) "green"))
				      (with-organism (:org-id 'xkegg)
					(append (loop for pwy in (all-kegg-maps)
						    when (reactions-of-pathway pwy)
						    collect (list (get-frame-name pwy) "Kegg Maps" (length (reactions-of-pathway pwy)) "red"))
						(loop for pwy in (all-kegg-modules)
						    collect (list (get-frame-name pwy) "Kegg Modules" (length (reactions-of-pathway pwy)) "orange")))))
				     
      do (format t "~A~C~A~C~A~C~A~%"
		 pwy
		 #\Tab
 		 source
		 #\Tab
		 num-rxns
		 #\Tab
		 color)))