Changeset 27738 in project


Ignore:
Timestamp:
10/30/12 13:39:49 (7 years ago)
Author:
Ivan Raikov
Message:

neurolucida release 1.13

Location:
release/4/neurolucida
Files:
3 edited
2 copied

Legend:

Unmodified
Added
Removed
  • release/4/neurolucida/tags/1.12/neurolucida.scm

    r27734 r27738  
    214214(define (make-tree-graph label x)
    215215
    216   (let* ((sxml       `(*TOP* ,@(cdr x)))
    217          (g          (make-digraph label #f))
     216  (let* ((sxml           `(*TOP* ,@(cdr x)))
     217         (g              (make-digraph label #f))
    218218         (node-info      (g 'node-info))
    219219         (node-info-set! (g 'node-info-set!))
     
    224224    (add-node! 0 'soma)
    225225
    226     (let recur ((tree     ((sxpath `(nl:tree))  sxml))
    227                 (parent   0)
    228                 (node-id  1))
     226    (let ((initial-tree ((sxpath `(nl:tree))  sxml)))
     227
     228      (let recur ((tree      initial-tree)
     229                   (parent   0)
     230                   (node-id  1))
    229231
    230232      (let ((points+spines     ((sxpath `((*or* nl:point nl:spine))) tree))
     
    271273                        (recur subtree branch-node (+ i 1))) node-id1 subtrees))
    272274              node-id1)
    273           )))
     275          ))
     276      ))
    274277    g))
    275278
     
    291294;;
    292295
    293 (define (make-ng g #!key (permute-coords #f))
     296(define (make-ng key g #!key (permute-coords #f))
    294297
    295298  (define (sum lst) (fold + 0. lst))
     
    392395          )))
    393396
     397  (define (compute-node-tree roots out-edges node-info
     398                             node-orders node-depths inverse-node-depths)
     399
     400    (let recur ((node (car roots)) (ax '()))
     401             
     402      (let* ((info   (node-info node))
     403             (spines (sxml:kidsn 'nl:spine info))
     404             )
     405       
     406       
     407        (if (equal? info 'soma)
     408           
     409            (fold recur '() (map cadr (out-edges node)))
     410           
     411            (case (car info)
     412             
     413              ((nl:point)
     414               (let* ((oes (out-edges node))
     415                      (next-node (and (pair? oes) (cadr (car oes))))
     416                      (cylinder-origin (get-node-origin info))
     417                      (cylinder-radius (get-node-radius info))
     418                      (cylinder-length (and next-node
     419                                            (let ((node1-origin (get-node-origin (node-info next-node))))
     420                                              (sqrt (pdist2 cylinder-origin node1-origin))
     421                                              ))
     422                                       )
     423                      )
     424                 
     425                 (assert (<= (length oes) 1))
     426                 (and cylinder-length (assert (positive? cylinder-length)))
     427                 
     428                 (let ((ax1 (cons
     429                             (if next-node
     430                                 `(Node (origin . ,(or (and permute-coords (permute-coords cylinder-origin) )
     431                                                       cylinder-origin))
     432                                        (radius . ,cylinder-radius)
     433                                        (length . ,cylinder-length)
     434                                        (branch-order-Soma . ,(s32vector-ref node-depths node))
     435                                        (branch-order-Terminal . ,(s32vector-ref inverse-node-depths node))
     436                                        ,@(if (null? spines) '() `((spine-density-linear . ,(/ (length spines) cylinder-length))))
     437                                        )
     438                                 `(Terminal (origin . ,(or (and permute-coords (permute-coords cylinder-origin) )
     439                                                           cylinder-origin))
     440                                            (radius . ,cylinder-radius)
     441                                            (branch-order-Soma . ,(s32vector-ref node-depths node))
     442                                            (branch-order-Terminal . ,(s32vector-ref inverse-node-depths node))
     443                                            ))
     444                             ax)))
     445                   
     446                   (if next-node (recur next-node ax1) (reverse ax1))
     447                   
     448                   )
     449                 ))
     450             
     451              ((nl:branch)
     452               (let* ((branch-origin (get-node-origin info))
     453                      (branch-radius (get-node-radius info))
     454                      )
     455                 
     456                 (cons
     457                  `(Branch (origin . ,(or (and permute-coords (permute-coords branch-origin) )
     458                                          branch-origin))
     459                           (radius . ,branch-radius)
     460                           (branch-order-Soma . ,(s32vector-ref node-depths node))
     461                           (branch-order-Terminal . ,(s32vector-ref inverse-node-depths node))
     462                           (children . ,(map (lambda (x) (recur x '())) (map cadr (out-edges node))))
     463                           )
     464                  ax)
     465                 ))
     466             
     467              (else (recur (cdr nodes) ax)))
     468           
     469            ))
     470      ))
    394471 
    395472  (let* ((roots ((g 'roots)))
     
    402479
    403480
    404     (let recur ((node (car roots)) (ax '()))
    405 
    406        (let* ((info   (node-info node))
    407               (spines (sxml:kidsn 'nl:spine info))
    408               )
    409 
    410 
    411          (if (equal? info 'soma)
    412 
    413              (fold recur '() (map cadr (out-edges node)))
    414 
    415              (case (car info)
    416                
    417                ((nl:point)
    418                 (let* ((oes (out-edges node))
    419                        (next-node (and (pair? oes) (cadr (car oes))))
    420                        (cylinder-origin (get-node-origin info))
    421                        (cylinder-radius (get-node-radius info))
    422                        (cylinder-length (and next-node
    423                                              (let ((node1-origin (get-node-origin (node-info next-node))))
    424                                                  (sqrt (pdist2 cylinder-origin node1-origin))
    425                                                  ))
    426                                              )
    427                        )
    428 
    429                   (assert (<= (length oes) 1))
    430                   (and cylinder-length (assert (positive? cylinder-length)))
    431                  
    432                   (let ((ax1 (cons
    433                               (if next-node
    434                                   `(Node (origin . ,(or (and permute-coords (permute-coords cylinder-origin) )
    435                                                         cylinder-origin))
    436                                          (radius . ,cylinder-radius)
    437                                          (length . ,cylinder-length)
    438                                          (branch-order-Soma . ,(s32vector-ref node-depths node))
    439                                          (branch-order-Terminal . ,(s32vector-ref inverse-node-depths node))
    440                                          ,@(if (null? spines) '() `((spine-density-linear . ,(/ (length spines) cylinder-length))))
    441                                          )
    442                                   `(Terminal (origin . ,(or (and permute-coords (permute-coords cylinder-origin) )
    443                                                             cylinder-origin))
    444                                              (radius . ,cylinder-radius)
    445                                              (branch-order-Soma . ,(s32vector-ref node-depths node))
    446                                              (branch-order-Terminal . ,(s32vector-ref inverse-node-depths node))
    447                                    ))
    448                               ax)))
    449 
    450                     (if next-node (recur next-node ax1) (reverse ax1))
    451 
    452                     )
    453                 ))
    454                
    455                ((nl:branch)
    456                 (let* ((branch-origin (get-node-origin info))
    457                        (branch-radius (get-node-radius info))
    458                        )
    459                  
    460                   (cons
    461                    `(Branch (origin . ,(or (and permute-coords (permute-coords branch-origin) )
    462                                            branch-origin))
    463                             (radius . ,branch-radius)
    464                             (branch-order-Soma . ,(s32vector-ref node-depths node))
    465                             (branch-order-Terminal . ,(s32vector-ref inverse-node-depths node))
    466                             (children . ,(map (lambda (x) (recur x '())) (map cadr (out-edges node))))
    467                             )
    468                    ax)
    469                   ))
    470              
    471              (else (recur (cdr nodes) ax)))
    472          
    473              ))
    474        ))
    475   )
    476        
     481    (let ((tree
     482          `(((key . ,key)) .
     483            ,(compute-node-tree roots out-edges node-info
     484                                node-orders node-depths inverse-node-depths))))
     485
     486      tree
     487      )))
    477488     
    478489 
     
    809820          ((ng)
    810821           (let* ((permute-coords (opt 'permute-coords))
    811                   (permute-coords (and permute-coords
    812                                        (let ((permute-coords (map string->number (string-split permute-coords ","))))
    813                                          (if (not (and (list? permute-coords)
    814                                                        (= (length permute-coords) 3)
    815                                                        (every (lambda (x) (and (integer? x) (<= 1 x) (>= 3 x))) permute-coords)))
    816                                              (error "invalid point coordinate permutation indices" permute-coords))
    817                                          (let ((permute-coords (map (lambda (i) (- i 1)) permute-coords)))
    818                                            (lambda (p) (map (lambda (i) (list-ref p i)) permute-coords))
    819                                            ))
    820                                        ))
     822                  (permute-coords
     823                   (and permute-coords
     824                        (let ((permute-coords (map string->number (string-split permute-coords ","))))
     825                          (if (not (and (list? permute-coords)
     826                                        (= (length permute-coords) 3)
     827                                        (every (lambda (x) (and (integer? x) (<= 1 x) (>= 3 x))) permute-coords)))
     828                              (error "invalid point coordinate permutation indices" permute-coords))
     829                          (let ((permute-coords (map (lambda (i) (- i 1)) permute-coords)))
     830                            (lambda (p) (map (lambda (i) (list-ref p i)) permute-coords))
     831                            ))
     832                        ))
    821833                  )
    822834                                           
    823              (for-each (lambda (f x)
     835             (for-each (lambda (f k x)
    824836                         (with-output-to-file f
    825837                           (lambda ()
    826                              (pp (make-ng (make-tree-graph 'neurolucida x) permute-coords: permute-coords)
     838                             (pp (make-ng k (make-tree-graph 'neurolucida x)
     839                                          permute-coords: permute-coords)
    827840                                 (current-output-port)))))
    828841                       (map (lambda (x) (make-pathname ddir (car (string-split (cadar x) "#")) "ng")) data-map)
     842                       (map (lambda (x) (car (string-split (cadar x) "#"))) data-map)
    829843                       data-map)
    830844             ))
  • release/4/neurolucida/tags/1.13/neurolucida.setup

    r27733 r27738  
    99
    1010  ; Assoc list with properties for the program:
    11   '((version 1.12))
     11  '((version 1.13))
    1212  )
    1313
  • release/4/neurolucida/trunk/neurolucida.setup

    r27733 r27738  
    99
    1010  ; Assoc list with properties for the program:
    11   '((version 1.12))
     11  '((version 1.13))
    1212  )
    1313
Note: See TracChangeset for help on using the changeset viewer.