Changeset 27528 in project


Ignore:
Timestamp:
10/03/12 05:15:18 (9 years ago)
Author:
Ivan Raikov
Message:

neurolucide: added option --forest-bounds

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

Legend:

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

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

    r27323 r27528  
    2121
    2222(require-extension files data-structures srfi-1 srfi-13  getopt-long sxml-transforms sxpath sxpath-lolevel ssax)
    23 (require-extension iset digraph format-graph  )
     23(require-extension typeclass kd-tree iset digraph format-graph  )
     24
     25(import-instance (<KdTree> KdTree3d)
     26                 (<Point> Point3d))
    2427
    2528
     
    7578    (key             . "color")
    7679    (format          . "swc")
     80    (forest-bounds   . 10)
    7781    ))
    7882
     
    8791(define opt-grammar
    8892  `(
     93    (forest-bounds
     94     "print boundary coordinates of the entire forest (resolution is given in number of points)"
     95     (value       (optional "RESOLUTION")
     96                  (transformer ,string->number)
     97                  (default  ,(defopt 'forest-bounds))))
     98
    8999    (permute-coords
    90100     "permute coordinates of node points in NG format according to the given list of 1-based indices"
     
    602612
    603613
    604 
     614(define (print-bounds x nbndpts)
     615
     616  (define get (compose car alist-ref))
     617
     618  (let ((sxml `(*TOP* ,@x)))
     619
     620    (let ((bb.all-points
     621           (let recur ((trees ((sxpath `(nl:tree))  sxml))
     622                       (exs (list +inf.0 -inf.0
     623                                  +inf.0 -inf.0
     624                                  +inf.0 -inf.0))
     625                       (all-points '()))
     626             
     627             (if (null? trees) (cons exs all-points)
     628
     629                (let ((points     ((sxpath `(nl:point @))  (car trees)))
     630                      (subtrees   (append ((sxpath `(nl:tree))  (car trees))
     631                                          ((sxpath `(nl:branch))  (car trees)))))
     632                 
     633                    (let (
     634                          (exs.all-points
     635                           (fold (lambda (pt ax)
     636                                   (let ((data (cdr pt)))
     637
     638                                     (let ((x  (string->number (get 'x data)))
     639                                           (y  (string->number (get 'y data)))
     640                                           (z  (string->number (get 'z data))))
     641
     642                                       (let* ((exs (car ax))
     643                                              (all-points (cdr ax))
     644                                              (x-min (list-ref exs 0))
     645                                              (x-max (list-ref exs 1))
     646                                              (y-min (list-ref exs 2))
     647                                              (y-max (list-ref exs 3))
     648                                              (z-min (list-ref exs 4))
     649                                              (z-max (list-ref exs 5)))
     650                                         
     651
     652                                         (cons
     653                                          (list (min x x-min) (max x x-max)
     654                                                (min y y-min) (max y y-max)
     655                                                (min z z-min) (max z z-max))
     656                                          (cons (make-point x y z) all-points))
     657                                         ))
     658                                     ))
     659                                 (cons exs all-points) points))
     660                          )
     661                   
     662                      (if (pair? subtrees)
     663                          (fold (lambda (subtree ax) (recur subtree (car ax) (cdr ax )))
     664                                exs.all-points subtrees)
     665                          (recur (cdr trees) (car exs.all-points) (cdr exs.all-points)))
     666                      ))
     667                  ))
     668              ))
     669
     670      (if (null? (cdr bb.all-points))
     671          (error "empty point set in forest"))
     672
     673      (let* (
     674             (bb (car bb.all-points))
     675             (x-min (list-ref bb 0))
     676             (x-max (list-ref bb 1))
     677             (y-min (list-ref bb 2))
     678             (y-max (list-ref bb 3))
     679             (z-min (list-ref bb 4))
     680             (z-max (list-ref bb 5))
     681             (point-tree (list->kd-tree (cdr bb.all-points)))
     682             )
     683       
     684        (let* ((x-extent (ceiling (- x-max x-min)))
     685               (y-extent (ceiling (- y-max y-min)))
     686               (x-step (ceiling (abs (/ x-extent nbndpts))))
     687               (y-step (ceiling (abs (/ y-extent nbndpts))))
     688               )
     689         
     690          (printf "# x-min: ~A x-max: ~A y-min: ~A y-max ~A z-min: ~A z-max ~A~%"
     691                  x-min x-max y-min y-max z-min z-max)
     692         
     693         
     694          (let ( (bndps1 ;; left side in X-Y plane
     695                  (list-tabulate nbndpts (lambda (i) (make-point x-min (+ y-min (* i y-step)) 0.))))
     696                 (bndps2 ;; top side in X-Y plane
     697                  (list-tabulate nbndpts (lambda (i) (make-point (+ x-min (* i x-step)) y-max 0.))))
     698                 (bndps3 ;; right side in X-Y plane
     699                  (list-tabulate nbndpts (lambda (i) (make-point x-max (+ y-min (* i y-step)) 0.))))
     700                 (bndps4 ;; bottom side in X-Y plane
     701                  (list-tabulate nbndpts (lambda (i) (make-point (+ x-min (* i x-step)) y-min 0.))))
     702                 )
     703           
     704            (printf "# Boundary 1~%")
     705            (let* ((t1
     706                    (fold (lambda (bndpt t)
     707                            (let ((pt (kd-tree-nearest-neighbor t bndpt)))
     708                              (printf "~A ~A ~A~%" (coord 0 pt) (coord 1 pt) (coord 2 pt))
     709                              (kd-tree-remove t pt))
     710                            )
     711                          point-tree bndps1))
     712                   (dum (printf "# Boundary 2~%"))
     713                   (t2
     714                    (fold (lambda (bndpt t)
     715                            (let ((pt (kd-tree-nearest-neighbor t bndpt)))
     716                              (printf "~A ~A ~A~%" (coord 0 pt) (coord 1 pt) (coord 2 pt))
     717                              (kd-tree-remove t pt))
     718                            )
     719                          point-tree bndps2))
     720                   (dum (printf "# Boundary 3~%"))
     721                   (t3
     722                    (fold (lambda (bndpt t)
     723                            (let ((pt (kd-tree-nearest-neighbor t bndpt)))
     724                              (printf "~A ~A ~A~%" (coord 0 pt) (coord 1 pt) (coord 2 pt))
     725                              (kd-tree-remove t pt))
     726                            )
     727                          point-tree bndps3))
     728                   (dum (printf "# Boundary 4~%"))
     729                   (t4
     730                    (fold (lambda (bndpt t)
     731                            (let ((pt (kd-tree-nearest-neighbor t bndpt)))
     732                              (printf "~A ~A ~A~%" (coord 0 pt) (coord 1 pt) (coord 2 pt))
     733                              (kd-tree-remove t pt))
     734                            )
     735                          point-tree bndps4))
     736                   )
     737             
     738              (begin)
     739            ))
     740        ))
     741    ))
     742  )
    605743
    606744
     
    636774           )
    637775
     776      (if (opt 'forest-bounds)
     777          (with-output-to-file (make-pathname ddir "forest.bounds")
     778            (lambda () (for-each (lambda (x) (print-bounds x (or (and (number? (opt 'forest-bounds) ) (opt 'forest-bounds) )
     779                                                                 (defopt 'forest-bounds))))
     780                                 data-map))))
    638781
    639782        (case format
     783
    640784          ((pts)
    641785           (for-each (lambda (f x)
  • release/4/neurolucida/trunk/neurolucida.setup

    r27324 r27528  
    99
    1010  ; Assoc list with properties for the program:
    11   '((version 1.7))
     11  '((version 1.8))
    1212  )
    1313
Note: See TracChangeset for help on using the changeset viewer.