Changeset 27216 in project


Ignore:
Timestamp:
08/07/12 03:08:43 (9 years ago)
Author:
Ivan Raikov
Message:

neurolucida: avoid duplicate points when building neurolucida graph

File:
1 edited

Legend:

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

    r27214 r27216  
    176176
    177177
     178(define (get-node-origin x)
     179  (let ((x (if (equal? 'nl:point (car x)) x (sxml:kidn 'nl:point x))))
     180    (let ((attrs (sxml:attr-alist x)))
     181      (list (string->number (car (lookup-def 'x attrs)))
     182            (string->number (car (lookup-def 'y attrs)))
     183            (string->number (car (lookup-def 'z attrs))))
     184      )))
     185
     186
     187(define (get-node-radius x)
     188  (let ((x (if (equal? 'nl:point (car x)) x (sxml:kidn 'nl:point x))))
     189    (let ((attrs (sxml:attr-alist x)))
     190      (/ (string->number (car (lookup-def 'd attrs))) 2.))))
     191
     192
    178193(define (make-tree-graph label x)
    179194
     
    198213        ;; insert points in the dependency graph
    199214        (let ((node-id1
    200                (fold (lambda (n i)
     215               (car
     216               (fold (lambda (n i.lp)
    201217                       (case (car n)
    202218                         ((nl:point)
    203                           (begin
    204                             (add-node! i n) (+ 1 i)))
     219                          (let ((i (car i.lp))
     220                                (lp (cdr i.lp)))
     221
     222                            (if (not (equal? lp n))
     223                                (begin
     224                                  (add-node! i n) (cons (+ 1 i) n))
     225                                i.lp)))
    205226                         ((nl:spine)
    206                           (begin
    207                             (node-info-set! (- i 1) (append (node-info (- i 1)) (list n))) i))
     227                          (let ((i (car i.lp)) (lp (cdr i.lp)))
     228                            (node-info-set! (- i 1) (append (node-info (- i 1)) (list n)))
     229                            i.lp))
    208230                         (else (error 'make-tree-graph "unknown node type" n))))
    209                      node-id points+spines)))
     231                     (cons node-id  #f)
     232                     points+spines))))
    210233         
    211234          ;; insert edges
     
    255278    (let ((diff2 (lambda (i) (let ((v (- (list-ref a i) (list-ref b i)))) (* v v)))))
    256279      (sum (list-tabulate 3 diff2))))
    257 
    258 
    259   (define (get-node-origin x)
    260     (let ((x (if (equal? 'nl:point (car x)) x (sxml:kidn 'nl:point x))))
    261       (let ((attrs (sxml:attr-alist x)))
    262         (list (string->number (car (lookup-def 'x attrs)))
    263               (string->number (car (lookup-def 'y attrs)))
    264               (string->number (car (lookup-def 'z attrs))))
    265         )))
    266 
    267 
    268   (define (get-node-radius x)
    269     (let ((x (if (equal? 'nl:point (car x)) x (sxml:kidn 'nl:point x))))
    270       (let ((attrs (sxml:attr-alist x)))
    271         (/ (string->number (car (lookup-def 'd attrs))) 2.))))
    272 
    273  
    274280   
    275281  ;;
     
    312318         )
    313319
     320    (print "inverse-node-depths = " inverse-node-depths)
     321    (print "node-depths = " node-depths)
     322
    314323    (let recur ((node (car roots)) (ax '()))
    315324
     
    318327              )
    319328
    320          (print "info = " info)
    321329
    322330         (if (equal? info 'soma)
     
    329337                (let* ((oes (out-edges node))
    330338                       (next-node (and (pair? oes) (cadr (car oes))))
    331                        (dd (print "next-node = " next-node))
    332                        (dd (print "info next-node = " (and next-node (node-info next-node))))
    333339                       (cylinder-origin (get-node-origin info))
    334340                       (cylinder-radius (get-node-radius info))
     
    339345                                             )
    340346                       )
    341 
    342                   (print "cylinder-length = " cylinder-length)
    343347
    344348                  (assert (<= (length oes) 1))
Note: See TracChangeset for help on using the changeset viewer.