Changeset 31141 in project


Ignore:
Timestamp:
07/22/14 11:01:36 (6 years ago)
Author:
Ivan Raikov
Message:

picnic: more work on swc support

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/picnic/trunk/picnic-utils.scm

    r31140 r31141  
    2828        (require-extension srfi-69 datatype matchable vector-lib
    2929                           mpi mathh typeclass kd-tree random-mtzig
    30                            lalr-driver)
     30                           lalr-driver digraph graph-dfs)
    3131
    3232
     
    880880                    (let ((point (car lst)))
    881881                     
    882                       (let ((node-id     (swcpoint-id point))
    883                             (pre-id      (swcpoint-pre point)))
     882                      (let ((node-id (swcpoint-id point))
     883                            (pre-id  (swcpoint-pre point)))
    884884                       
    885                         (let* ((pre-point (node-info pre-id))
     885                        (let* ((pre-point  (node-info pre-id))
    886886                               (pre-coords (swcpoint-coords pre-point))
    887                                (distance (sqrt (dist2 node-coords pre-coords))))
     887                               (distance   (sqrt (dist2 node-coords pre-coords))))
    888888                         
    889889                          (add-edge! (list node-id pre-id distance))
     
    896896            )
    897897
    898 
    899         (define (tree-graph->genpoints g type)
     898        (define (tree-graph-distances+segments g)
     899
     900          (define n        ((g 'capacity)))
     901          (define distv    (make-f64vector (+ 1 n) -1.0))
     902         
     903          (define (traverse es)
     904            (if (null? es) distv
     905                (match-let (((i j dist) (car es)))
     906                  (if (>= (f64vector-ref distv j) 0.0)
     907                      (traverse (cdr es))
     908                      (let ((idist (f64vector-ref distv i)))
     909                        (f64vector-set! distv j (+ idist dist))
     910                        (let ((distv1 (traverse ((g 'out-edges) j))))
     911                          (traverse es)))
     912                      ))
     913                ))
     914         
     915          (let ((root 1))
     916            (f64vector-set! distv root 0.0)
     917            (traverse ((g 'out-edges) root))
     918            distv)
     919          )
     920
     921        (define (tree-graph->genpoints g gdistv gsegv type cell-index)
    900922         
    901923          (let ((node-info (g 'node-info))
    902924                (out-edges (g 'out-edges)))
    903            
    904             (let recur ((root 1) (lst '()))
     925
     926            (let recur ((n 1) (lst '()))
    905927
    906928              (let* (
    907929                     (point (node-info root))
    908930                     (point-type (swcpoint-type point))
     931                     (point-pre (swcpoint-pre point))
    909932                     (proceed? (or (= point-type type)
    910933                                   (case (swcpoint-type point)
     
    914937                 
    915938                (if proceed?
    916                     (let* ((point1 (make-genpoint
    917                                     (swcpoint-coords point)
    918                                     parent-index
    919                                     parent-distance
    920                                     segment)))
     939
     940                    (let (
     941                          (point1 (make-genpoint
     942                                   (swcpoint-coords point)
     943                                   cell-index
     944                                   (f64vector-ref gdistv n)
     945                                   (s32vector-ref gsegv n)))
     946                          )
     947
    921948                      (fold (lambda (x ax) (recur x ax)) (cons point1 lst) (out-edges root)))
     949
    922950                    lst)
    923951
     
    926954
    927955 
    928         (define (load-swc filename type label)
     956        (define (load-swc filename type label index)
    929957         
    930958          (let ((in (open-input-file filename)))
     
    932960            (if (not in) (error 'load-swc "file not found" filename))
    933961           
    934             (let* ((lines
     962            (let* (
     963                   (lines
    935964                    (filter (lambda (line) (not (irregex-match comment-pat line)))
    936965                            (read-lines in)))
     966
    937967                   (swc-data
    938968                    (filter-map
     
    948978                   (swc-graph (make-tree-graph swc-data label))
    949979
    950                    (point-data (tree-graph->genpoints swc-graph type))
    951 
    952                    (point-tree (list->kd-tree point-data))
     980                   (dist+segs  (tree-graph-distances+segments swc-graph))
     981                   (point-data (tree-graph->genpoints
     982                                swc-graph (car dist+segs) (cadr dist+segs)
     983                                type index))
     984
    953985                   )
    954986
    955               (list point-tree))
     987              (list point-data))
    956988          ))
    957989
Note: See TracChangeset for help on using the changeset viewer.