sagemap.lisp

   1 (in-package :bioinfo)
   2
   3 (defparameter *sagemaps* '(:genie   (:human (:short #p"data/genie/Hs_short.best_gene"
   4                                              :long  #p"data/genie/Hs_long.best_gene"))
   5                            :sagemap (:human (:short #p"data/sagemap/HS/NLAIII/SAGEmap_tag_ug-rel"
   6                                             :long  #p"data/sagemap/HS/NLAIII/SAGEmap_tag_ug-rel")))
   7   "plist of available sagemaps")
   8
   9
  10 (defun find-sagemap (library organism tag-kind)
  11   (getf (getf (getf *sagemaps* library ) organism) tag-kind))
  12
  13 (defun load-sagemap (&key (library :genie) (organism :human) (tag-kind :short))
  14   "Load the apropriate library"
  15   (load-sagemap-file
  16    (merge-pathnames (find-sagemap library organism tag-kind)   *system-path*)
  17    tag-kind))
  18
  19 (defun load-sagemap-file (filespec tag-kind)
  20   "Load the sagemap into a hash table"
  21   (let ((map (make-hash-table :test 'equal :size 10000)))
  22     (with-open-file (in filespec :external-format :latin-1)
  23       (each-line (in line)
  24         (let* ((lst (split-sequence #\Tab line))
  25                (tag (first lst)))
  26           (ecase tag-kind
  27             (:short
  28              (when (eq 10 (length tag))
  29                (setf (gethash tag map) (rest lst))))
  30             (:long
  31              (when (> (length tag) 10)
  32                (setf (gethash tag map) (rest lst))))))))
  33     map))
  34
  35
  36 (defun map-tag (tag map)
  37   "Map a single tag to the given map"
  38   (multiple-value-bind (value founded)
  39       (gethash (string-upcase tag) map)
  40     (if founded
  41         value
  42         (list "[* TAG NOT FOUNDED IN MAP *]"))))
  43
  44
  45 (defun map-each-file-line (file map)
  46   "map-tag first column of the given file"
  47   (with-open-file (in file)
  48     (let ((fmt (concatenate 'string "~{~a~^" '(#\Tab) "~}")))
  49       (each-line (in line)
  50         (let ((lst (split-sequence #\Tab line)))
  51           (fresh-line)
  52           (if (equal (string-downcase (first lst)) "tag")
  53               (progn
  54                 (princ line)
  55                 (princ #\Tab)
  56                 (princ "Annotation"))
  57               (progn
  58                 (princ line)
  59                 (princ #\Tab)
  60                 (format t fmt (map-tag (first lst) map)))))))))
  61
  62
  63
  64 (defun annotate-tags-file (tagsfile map)
  65   "Read a file with tags in the first column, and
  66 save the annotation to another file with same name, but with
  67 extension ann.csv"
  68   (when (eq (type-of map) 'cons)
  69     (setf map (apply #'load-sagemap map)))
  70   (redirect (make-pathname :defaults tagsfile :type "csv")
  71     (map-each-file-line tagsfile map))
  72   #+sbcl(sb-ext:gc))