Changeset 27323 in project
- Timestamp:
- 08/29/12 04:37:25 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/neurolucida/trunk/neurolucida.scm
r27232 r27323 87 87 (define opt-grammar 88 88 `( 89 (permute-coords 90 "permute coordinates of node points in NG format according to the given list of 1-based indices" 91 (value (required INDICES))) 92 89 93 (data-dir 90 94 "set download directory (default is a randomly generated name in /tmp)" … … 270 274 ;; 271 275 272 (define (make-ng g )276 (define (make-ng g #!key (permute-coords #f)) 273 277 274 278 (define (sum lst) (fold + 0. lst)) … … 411 415 (let ((ax1 (cons 412 416 (if next-node 413 `(Node (origin . ,cylinder-origin) 417 `(Node (origin . ,(or (and permute-coords (permute-coords cylinder-origin) ) 418 cylinder-origin)) 414 419 (radius . ,cylinder-radius) 415 420 (length . ,cylinder-length) … … 418 423 ,@(if (null? spines) '() `((spine-density-linear . ,(/ (length spines) cylinder-length)))) 419 424 ) 420 `(Terminal (origin . ,cylinder-origin) 425 `(Terminal (origin . ,(or (and permute-coords (permute-coords cylinder-origin) ) 426 cylinder-origin)) 421 427 (radius . ,cylinder-radius) 422 428 (branch-order-Soma . ,(s32vector-ref node-depths node)) … … 436 442 437 443 (cons 438 `(Branch (origin . ,branch-origin) 444 `(Branch (origin . ,(or (and permute-coords (permute-coords branch-origin) ) 445 branch-origin)) 439 446 (radius . ,branch-radius) 440 447 (branch-order-Soma . ,(s32vector-ref node-depths node)) … … 608 615 (d "data directory is ~s~%" (get-data-dir)) 609 616 610 (let* ((data-map 617 (let* ((format (string->symbol (or (opt 'format) (defopt 'format)))) 618 (data-map 611 619 (concatenate 612 620 (map (lambda (p) … … 618 626 (elms (append contours trees)) 619 627 (data-map '())) 628 620 629 (if (null? keys) 621 (if (null? elms) data-map ( error "elements with unknown color" elms))630 (if (null? elms) data-map (if (equal? format 'ng) data-map (error "elements with unknown color" elms))) 622 631 (let-values (((lst rest) (partition-by-key elms (car keys) key=?))) 623 632 (recur (cdr keys) rest (cons (cons (car keys) (map cadr lst)) data-map))))) … … 627 636 ) 628 637 629 (let ((format (string->symbol (or (opt 'format) (defopt 'format)))))630 638 631 639 (case format … … 653 661 654 662 ((ng) 655 (for-each (lambda (f x) 656 (with-output-to-file f 657 (lambda () 658 (pp (make-ng (make-tree-graph 'neurolucida x)) (current-output-port))))) 659 (map (lambda (x) (make-pathname ddir (car (string-split (cadar x) "#")) "ng")) data-map) 660 data-map)) 661 663 (let* ((permute-coords (opt 'permute-coords)) 664 (permute-coords (and permute-coords 665 (let ((permute-coords (map string->number (string-split permute-coords ",")))) 666 (if (not (and (list? permute-coords) 667 (= (length permute-coords) 3) 668 (every (lambda (x) (and (integer? x) (<= 1 x) (>= 3 x))) permute-coords))) 669 (error "invalid point coordinate permutation indices" permute-coords)) 670 (let ((permute-coords (map (lambda (i) (- i 1)) permute-coords))) 671 (lambda (p) (map (lambda (i) (list-ref p i)) permute-coords)) 672 )) 673 )) 674 ) 675 676 (for-each (lambda (f x) 677 (with-output-to-file f 678 (lambda () 679 (pp (make-ng (make-tree-graph 'neurolucida x) permute-coords: permute-coords) 680 (current-output-port))))) 681 (map (lambda (x) (make-pathname ddir (car (string-split (cadar x) "#")) "ng")) data-map) 682 data-map) 683 )) 662 684 )) 663 )) )685 )) 664 686 665 687 (main)
Note: See TracChangeset
for help on using the changeset viewer.