Changeset 31140 in project


Ignore:
Timestamp:
07/22/14 04:18:27 (6 years ago)
Author:
Ivan Raikov
Message:

fixes to swc support

File:
1 edited

Legend:

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

    r31066 r31140  
    108108          )
    109109
    110 
    111        
    112 
    113110        (define-record-type genpoint (make-genpoint coords parent-index parent-distance segment)
    114111          genpoint?
     
    117114          (parent-distance genpoint-parent-distance)
    118115          (segment genpoint-segment)
     116          )
     117
     118        (define-record-type swcpoint (make-swcpoint id type coords radius pre)
     119          swcpoint?
     120          (id swcpoint-id)
     121          (type swcpoint-type)
     122          (coords swcpoint-coords)
     123          (radius swcpoint-radius)
     124          (pre swcpoint-pre)
    119125          )
    120126
     
    845851
    846852
     853        (define (make-tree-graph lst label)
     854         
     855          (let* (
     856                 (g              (make-digraph label #f))
     857                 (node-info      (g 'node-info))
     858                 (node-info-set! (g 'node-info-set!))
     859                 (add-node!      (g 'add-node!))
     860                 (add-edge!      (g 'add-edge!))
     861                 )
     862
     863            ;; insert nodes
     864            (let recur ((lst lst))
     865
     866              (if (not (null? lst))
     867
     868                  (let ((point (car lst)))
     869
     870                    (let ((node-id (swcpoint-id point)))
     871
     872                      (add-node! node-id point)
     873
     874                      (recur (cdr lst))))))
     875
     876              (let recur ((lst lst))
     877               
     878                (if (not (null? lst))
     879                   
     880                    (let ((point (car lst)))
     881                     
     882                      (let ((node-id     (swcpoint-id point))
     883                            (pre-id      (swcpoint-pre point)))
     884                       
     885                        (let* ((pre-point (node-info pre-id))
     886                               (pre-coords (swcpoint-coords pre-point))
     887                               (distance (sqrt (dist2 node-coords pre-coords))))
     888                         
     889                          (add-edge! (list node-id pre-id distance))
     890                         
     891                          (recur (cdr lst))
     892                          ))
     893                      ))
     894                ))
     895            g
     896            )
     897
     898
     899        (define (tree-graph->genpoints g type)
     900         
     901          (let ((node-info (g 'node-info))
     902                (out-edges (g 'out-edges)))
     903           
     904            (let recur ((root 1) (lst '()))
     905
     906              (let* (
     907                     (point (node-info root))
     908                     (point-type (swcpoint-type point))
     909                     (proceed? (or (= point-type type)
     910                                   (case (swcpoint-type point)
     911                                     ((0 1 5 6) #t)
     912                                     (else #f))))
     913                     )
     914                 
     915                (if proceed?
     916                    (let* ((point1 (make-genpoint
     917                                    (swcpoint-coords point)
     918                                    parent-index
     919                                    parent-distance
     920                                    segment)))
     921                      (fold (lambda (x ax) (recur x ax)) (cons point1 lst) (out-edges root)))
     922                    lst)
     923
     924                ))
     925            ))
     926
     927 
     928        (define (load-swc filename type label)
     929         
     930          (let ((in (open-input-file filename)))
     931           
     932            (if (not in) (error 'load-swc "file not found" filename))
     933           
     934            (let* ((lines
     935                    (filter (lambda (line) (not (irregex-match comment-pat line)))
     936                            (read-lines in)))
     937                   (swc-data
     938                    (filter-map
     939                     (lambda (line)
     940                       (let ((lst (map string->number (string-split line " \t"))))
     941                         (and (not (null? lst))
     942                              (match-let (((id my-type x y z radius parent) lst))
     943                                         (make-swcpoint id type (make-point x y z)
     944                                                        radius parent-index)))
     945                         ))
     946                     lines))
     947
     948                   (swc-graph (make-tree-graph swc-data label))
     949
     950                   (point-data (tree-graph->genpoints swc-graph type))
     951
     952                   (point-tree (list->kd-tree point-data))
     953                   )
     954
     955              (list point-tree))
     956          ))
     957
     958
     959
     960
    847961        (define (segment-projection label source-tree target-sections zone my-comm myrank size)
    848962
Note: See TracChangeset for help on using the changeset viewer.