Changeset 27172 in project


Ignore:
Timestamp:
08/03/12 09:55:27 (9 years ago)
Author:
Ivan Raikov
Message:

neurolucida: added VCG output format

Location:
release/4/neurolucida/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/neurolucida/trunk/neurolucida.meta

    r23781 r27172  
    1818 ; A list of eggs neurolucida depends on.
    1919
    20  (needs sxml-transforms sxpath ssax getopt-long)
     20 (needs sxml-transforms sxpath ssax getopt-long digraph format-graph)
    2121
    2222 (author "Ivan Raikov")
    2323
    24  (synopsis "Print Neurolucida XML files in SWC format."))
     24 (synopsis "Output Neurolucida XML files in various formats."))
  • release/4/neurolucida/trunk/neurolucida.scm

    r26081 r27172  
    33;; Neurolucida XML file manipulation.
    44;;
    5 ;; Copyright 2011 Ivan Raikov and the Okinawa Institute of Science and
     5;; Copyright 2011-2012 Ivan Raikov and the Okinawa Institute of Science and
    66;; Technology.
    77;;
     
    2020;;
    2121
    22 (require-extension files data-structures srfi-1 srfi-13  sxml-transforms sxpath ssax getopt-long )
     22(require-extension files data-structures srfi-1 srfi-13  getopt-long sxml-transforms sxpath sxpath-lolevel ssax)
     23(require-extension digraph format-graph  )
    2324
    2425
     
    8182
    8283    (format
    83      "output format (swc or asc)"
     84     "output format (swc, asc, vcg)"
    8485     (single-char #\f)
    8586     (value       (required "FORMAT")
     
    144145
    145146
    146 
    147 
    148147(define (extract-element sxml element-name key-attr)
    149148  (let ((element-fullname (string->symbol (conc "nl:" (->string element-name)))))
     
    158157(define (partition-by-key a k key=?)
    159158  (partition (lambda (x) (equal? (car x) k)) a))
     159
     160
     161(define (make-tree-graph label x)
     162
     163  (let* ((sxml       `(*TOP* ,@(cdr x)))
     164         (g          (make-digraph label #f))
     165         (add-node!  (g 'add-node!))
     166         (add-edge!  (g 'add-edge!)))
     167
     168    (add-node! 0 'soma)
     169
     170    (let recur ((tree     ((sxpath `(nl:tree))  sxml))
     171                (parent   0)
     172                (node-id  1))
     173
     174      (let ((points+spines     ((sxpath `((*or* nl:point nl:spine))) tree))
     175            (subtrees          (append ((sxpath `(nl:tree)) tree)
     176                                       ((sxpath `(nl:branch)) tree))))
     177
     178        (let ((n (length points+spines)))
     179         
     180          ;; insert points and spines in the dependency graph
     181          (let ((node-id1 (fold (lambda (n i) (add-node! i n) (+ 1 i)) node-id points+spines)))
     182           
     183            ;; insert edges
     184            (if (positive? n)
     185                (let ((fin (- node-id1 1)))
     186                  (add-edge! (list parent node-id #f))
     187                  (let inner-recur ((i node-id))
     188                    (if (< i fin)
     189                        (let ((j (+ 1 i)))
     190                          (add-edge! (list i j  #f))
     191                          (inner-recur j))
     192                        ))
     193                  ))
     194           
     195            (if (pair? subtrees)
     196                (let ((branch-node (- node-id1 1))) ;; make the last node to be branching node
     197                  ((g 'node-info-set!) branch-node (cons 'branch ((g 'node-info) branch-node)))
     198                  (fold (lambda (subtree i) (recur subtree branch-node i)) node-id1 subtrees))
     199                node-id1
     200                ))
     201          ))
     202      )
     203    g))
     204
     205
    160206
    161207;;
     
    299345
    300346
     347
     348
     349
     350
    301351(define (main)
    302352
     
    325375           (ddir (get-data-dir))
    326376           )
     377
    327378      (let ((format (string->symbol (or (opt 'format) (defopt 'format)))))
    328379
     
    341392                     (map (lambda (x) (make-pathname ddir (car (string-split (cadar x) "#")) ".swc")) data-map)
    342393                     data-map))
     394
     395          ((vcg)
     396           (for-each (lambda (f x)
     397                       (with-output-to-file f
     398                         (lambda ()
     399                           ((make-format-graph 'vcg) (current-output-port) (make-tree-graph 'neurolucida x)))))
     400                     (map (lambda (x) (make-pathname ddir (car (string-split (cadar x) "#")) "vcg")) data-map)
     401                     data-map))
    343402          ))
    344403      )))
  • release/4/neurolucida/trunk/neurolucida.setup

    r26081 r27172  
    11;;;; -*- Hen -*-
    22
    3 (compile -O3 -d0 -b -heap-initial-size 8192k neurolucida.scm)
     3(compile -S -O -d2 -b -heap-initial-size 8192k neurolucida.scm)
    44
    55(install-program
     
    99
    1010  ; Assoc list with properties for the program:
    11   '((version 1.4))
     11  '((version 1.5))
    1212  )
    1313
Note: See TracChangeset for help on using the changeset viewer.