Changeset 27229 in project


Ignore:
Timestamp:
08/09/12 09:04:05 (9 years ago)
Author:
Ivan Raikov
Message:

neurolucida: completed ng format implementation

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

Legend:

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

    r27214 r27229  
    1818 ; A list of eggs neurolucida depends on.
    1919
    20  (needs sxml-transforms sxpath ssax getopt-long (digraph 1.16) graph-dfs format-graph)
     20 (needs sxml-transforms sxpath ssax getopt-long (digraph 1.16) iset format-graph)
    2121
    2222 (author "Ivan Raikov")
  • release/4/neurolucida/trunk/neurolucida.scm

    r27221 r27229  
    2121
    2222(require-extension files data-structures srfi-1 srfi-13  getopt-long sxml-transforms sxpath sxpath-lolevel ssax)
    23 (require-extension digraph graph-dfs format-graph  )
     23(require-extension iset digraph format-graph  )
    2424
    2525
     
    278278    (let ((diff2 (lambda (i) (let ((v (- (list-ref a i) (list-ref b i)))) (* v v)))))
    279279      (sum (list-tabulate 3 diff2))))
     280 
     281
     282  ;; DFS that increases depth only when branches are encountered
     283  (define (branch-dfs-fold g fn fb roots x y
     284                           #!key
     285                           (edge-target cadr)
     286                           (next-edges (g 'out-edges)))
     287   
     288
     289    (define (traverse visited n x y)
     290      (if (bit-vector-ref visited n)
     291          (values visited x y)
     292          (let ((visited (bit-vector-set! visited n #t))
     293                (x1 (fn n x y)))
     294            (traverse-edges visited (next-edges n) x1 y))
     295          ))
     296
     297   
     298    (define (traverse-edges visited elst x y) =
     299      (if (null? elst)
     300          (values visited x y)
     301          (let ((n (edge-target (car elst)))
     302                (es (cdr elst)))
     303            (if (bit-vector-ref visited n)
     304                (traverse-edges visited es x y)
     305                (let ((visited (bit-vector-set! visited n #t))
     306                      (x (fn n x y)))
     307                  (let ((enext (next-edges n))
     308                        (out-edges ((g 'out-edges) n)))
     309                    (let ((y (if (> (length out-edges) 1)
     310                                 (fb n out-edges x y) y)))
     311                      (let-values (((visited x y) 
     312                                    (traverse-edges visited enext x y)))
     313                        (traverse-edges visited es x y)
     314                        ))
     315                    ))
     316                ))
     317          ))
     318
     319   
     320    (define (traverse-roots visited ns x y)
     321      (if (null? ns) (values visited x y)
     322          (let-values (((visited x y) (traverse visited (car ns) x y)))
     323            (traverse-roots visited (cdr ns) x y))))
     324
     325   
     326    (traverse-roots (make-bit-vector ((g 'capacity))) roots x y)
     327    )
     328
     329
    280330   
    281331  ;;
     
    283333  ;;
    284334 
    285   (define (compute-node-orders g roots)
    286    
    287     (let ((ginv  (make-digraph (g 'name) (g 'graph-info))))
     335  (define (compute-node-orders g)
    288336     
    289       ;; create an inverse of the graph
    290       (let ((add-node! (ginv 'add-node!))
    291             (add-edge! (ginv 'add-edge!)))
    292         ((g 'foreach-node) (lambda (i x) (add-node! i x)))
    293         ((g 'foreach-edge) (lambda (i ee)
    294                              (for-each
    295                               (lambda (e)
    296                                 (add-edge! (list (cadr e) (car e) (caddr e))))
    297                               ee)))
    298         )
    299      
    300       (let (;; branch order from soma
    301             (node-depth (graph-dfs-depth g roots))
    302             ;; branch order from terminals
    303             (inverse-node-depth (graph-dfs-depth ginv ((ginv 'roots))))
    304             )
     337    (let ((roots ((g 'roots)))
     338          (terminals  ((g 'terminals))))
     339
     340      (let-values (
     341                   ((visited node-branch-order final-branch-depth) ;; branch order from soma
     342                    (branch-dfs-fold g
     343                                     (lambda (n x y) (s32vector-set! x n y) x)
     344                                     (lambda (n es x y) (+ 1 y))
     345                                     roots
     346                                     (make-s32vector ((g 'capacity)) -1) ;; branch order per node
     347                                     0 ;; branch order
     348                                     ))
     349                   ((visited node-inverse-branch-order final-inverse-branch-depth) ;; branch order from terminals
     350                    (branch-dfs-fold g
     351                                     (lambda (n x y) (s32vector-set! x n y) x)
     352                                     (lambda (n es x y) (+ 1 y))
     353                                     terminals
     354                                     (make-s32vector ((g 'capacity)) -1) ;; branch order per node
     355                                     0 ;; branch order
     356                                     edge-target: car
     357                                     next-edges: (g 'in-edges)
     358                                     ))
     359                   )
     360
     361        (let (
     362              ;; branch order from soma
     363              (node-depth node-branch-order)
     364              ;; branch order from terminals
     365              (inverse-node-depth node-inverse-branch-order)
     366              )
    305367       
    306         `((node-depth . ,node-depth)
    307           (inverse-node-depth . ,inverse-node-depth)
    308           )
    309         )))
     368          `((node-depth . ,node-depth)
     369            (inverse-node-depth . ,inverse-node-depth)
     370            ))
     371          )))
    310372
    311373 
     
    313375         (out-edges (g 'out-edges))
    314376         (node-info (g 'node-info))
    315          (node-orders (compute-node-orders g roots))
     377         (node-orders (compute-node-orders g))
    316378         (node-depths (lookup-def 'node-depth node-orders))
    317379         (inverse-node-depths (lookup-def 'inverse-node-depth node-orders))
Note: See TracChangeset for help on using the changeset viewer.