Changeset 27738 in project
 Timestamp:
 10/30/12 13:39:49 (7 years ago)
 Location:
 release/4/neurolucida
 Files:

 3 edited
 2 copied
Legend:
 Unmodified
 Added
 Removed

release/4/neurolucida/tags/1.12/neurolucida.scm
r27734 r27738 214 214 (define (maketreegraph label x) 215 215 216 (let* ((sxml `(*TOP* ,@(cdr x)))217 (g (makedigraph label #f))216 (let* ((sxml `(*TOP* ,@(cdr x))) 217 (g (makedigraph label #f)) 218 218 (nodeinfo (g 'nodeinfo)) 219 219 (nodeinfoset! (g 'nodeinfoset!)) … … 224 224 (addnode! 0 'soma) 225 225 226 (let recur ((tree ((sxpath `(nl:tree)) sxml)) 227 (parent 0) 228 (nodeid 1)) 226 (let ((initialtree ((sxpath `(nl:tree)) sxml))) 227 228 (let recur ((tree initialtree) 229 (parent 0) 230 (nodeid 1)) 229 231 230 232 (let ((points+spines ((sxpath `((*or* nl:point nl:spine))) tree)) … … 271 273 (recur subtree branchnode (+ i 1))) nodeid1 subtrees)) 272 274 nodeid1) 273 ))) 275 )) 276 )) 274 277 g)) 275 278 … … 291 294 ;; 292 295 293 (define (makeng g #!key (permutecoords #f))296 (define (makeng key g #!key (permutecoords #f)) 294 297 295 298 (define (sum lst) (fold + 0. lst)) … … 392 395 ))) 393 396 397 (define (computenodetree roots outedges nodeinfo 398 nodeorders nodedepths inversenodedepths) 399 400 (let recur ((node (car roots)) (ax '())) 401 402 (let* ((info (nodeinfo node)) 403 (spines (sxml:kidsn 'nl:spine info)) 404 ) 405 406 407 (if (equal? info 'soma) 408 409 (fold recur '() (map cadr (outedges node))) 410 411 (case (car info) 412 413 ((nl:point) 414 (let* ((oes (outedges node)) 415 (nextnode (and (pair? oes) (cadr (car oes)))) 416 (cylinderorigin (getnodeorigin info)) 417 (cylinderradius (getnoderadius info)) 418 (cylinderlength (and nextnode 419 (let ((node1origin (getnodeorigin (nodeinfo nextnode)))) 420 (sqrt (pdist2 cylinderorigin node1origin)) 421 )) 422 ) 423 ) 424 425 (assert (<= (length oes) 1)) 426 (and cylinderlength (assert (positive? cylinderlength))) 427 428 (let ((ax1 (cons 429 (if nextnode 430 `(Node (origin . ,(or (and permutecoords (permutecoords cylinderorigin) ) 431 cylinderorigin)) 432 (radius . ,cylinderradius) 433 (length . ,cylinderlength) 434 (branchorderSoma . ,(s32vectorref nodedepths node)) 435 (branchorderTerminal . ,(s32vectorref inversenodedepths node)) 436 ,@(if (null? spines) '() `((spinedensitylinear . ,(/ (length spines) cylinderlength)))) 437 ) 438 `(Terminal (origin . ,(or (and permutecoords (permutecoords cylinderorigin) ) 439 cylinderorigin)) 440 (radius . ,cylinderradius) 441 (branchorderSoma . ,(s32vectorref nodedepths node)) 442 (branchorderTerminal . ,(s32vectorref inversenodedepths node)) 443 )) 444 ax))) 445 446 (if nextnode (recur nextnode ax1) (reverse ax1)) 447 448 ) 449 )) 450 451 ((nl:branch) 452 (let* ((branchorigin (getnodeorigin info)) 453 (branchradius (getnoderadius info)) 454 ) 455 456 (cons 457 `(Branch (origin . ,(or (and permutecoords (permutecoords branchorigin) ) 458 branchorigin)) 459 (radius . ,branchradius) 460 (branchorderSoma . ,(s32vectorref nodedepths node)) 461 (branchorderTerminal . ,(s32vectorref inversenodedepths node)) 462 (children . ,(map (lambda (x) (recur x '())) (map cadr (outedges node)))) 463 ) 464 ax) 465 )) 466 467 (else (recur (cdr nodes) ax))) 468 469 )) 470 )) 394 471 395 472 (let* ((roots ((g 'roots))) … … 402 479 403 480 404 (let recur ((node (car roots)) (ax '())) 405 406 (let* ((info (nodeinfo node)) 407 (spines (sxml:kidsn 'nl:spine info)) 408 ) 409 410 411 (if (equal? info 'soma) 412 413 (fold recur '() (map cadr (outedges node))) 414 415 (case (car info) 416 417 ((nl:point) 418 (let* ((oes (outedges node)) 419 (nextnode (and (pair? oes) (cadr (car oes)))) 420 (cylinderorigin (getnodeorigin info)) 421 (cylinderradius (getnoderadius info)) 422 (cylinderlength (and nextnode 423 (let ((node1origin (getnodeorigin (nodeinfo nextnode)))) 424 (sqrt (pdist2 cylinderorigin node1origin)) 425 )) 426 ) 427 ) 428 429 (assert (<= (length oes) 1)) 430 (and cylinderlength (assert (positive? cylinderlength))) 431 432 (let ((ax1 (cons 433 (if nextnode 434 `(Node (origin . ,(or (and permutecoords (permutecoords cylinderorigin) ) 435 cylinderorigin)) 436 (radius . ,cylinderradius) 437 (length . ,cylinderlength) 438 (branchorderSoma . ,(s32vectorref nodedepths node)) 439 (branchorderTerminal . ,(s32vectorref inversenodedepths node)) 440 ,@(if (null? spines) '() `((spinedensitylinear . ,(/ (length spines) cylinderlength)))) 441 ) 442 `(Terminal (origin . ,(or (and permutecoords (permutecoords cylinderorigin) ) 443 cylinderorigin)) 444 (radius . ,cylinderradius) 445 (branchorderSoma . ,(s32vectorref nodedepths node)) 446 (branchorderTerminal . ,(s32vectorref inversenodedepths node)) 447 )) 448 ax))) 449 450 (if nextnode (recur nextnode ax1) (reverse ax1)) 451 452 ) 453 )) 454 455 ((nl:branch) 456 (let* ((branchorigin (getnodeorigin info)) 457 (branchradius (getnoderadius info)) 458 ) 459 460 (cons 461 `(Branch (origin . ,(or (and permutecoords (permutecoords branchorigin) ) 462 branchorigin)) 463 (radius . ,branchradius) 464 (branchorderSoma . ,(s32vectorref nodedepths node)) 465 (branchorderTerminal . ,(s32vectorref inversenodedepths node)) 466 (children . ,(map (lambda (x) (recur x '())) (map cadr (outedges node)))) 467 ) 468 ax) 469 )) 470 471 (else (recur (cdr nodes) ax))) 472 473 )) 474 )) 475 ) 476 481 (let ((tree 482 `(((key . ,key)) . 483 ,(computenodetree roots outedges nodeinfo 484 nodeorders nodedepths inversenodedepths)))) 485 486 tree 487 ))) 477 488 478 489 … … 809 820 ((ng) 810 821 (let* ((permutecoords (opt 'permutecoords)) 811 (permutecoords (and permutecoords 812 (let ((permutecoords (map string>number (stringsplit permutecoords ",")))) 813 (if (not (and (list? permutecoords) 814 (= (length permutecoords) 3) 815 (every (lambda (x) (and (integer? x) (<= 1 x) (>= 3 x))) permutecoords))) 816 (error "invalid point coordinate permutation indices" permutecoords)) 817 (let ((permutecoords (map (lambda (i) ( i 1)) permutecoords))) 818 (lambda (p) (map (lambda (i) (listref p i)) permutecoords)) 819 )) 820 )) 822 (permutecoords 823 (and permutecoords 824 (let ((permutecoords (map string>number (stringsplit permutecoords ",")))) 825 (if (not (and (list? permutecoords) 826 (= (length permutecoords) 3) 827 (every (lambda (x) (and (integer? x) (<= 1 x) (>= 3 x))) permutecoords))) 828 (error "invalid point coordinate permutation indices" permutecoords)) 829 (let ((permutecoords (map (lambda (i) ( i 1)) permutecoords))) 830 (lambda (p) (map (lambda (i) (listref p i)) permutecoords)) 831 )) 832 )) 821 833 ) 822 834 823 (foreach (lambda (f x)835 (foreach (lambda (f k x) 824 836 (withoutputtofile f 825 837 (lambda () 826 (pp (makeng (maketreegraph 'neurolucida x) permutecoords: permutecoords) 838 (pp (makeng k (maketreegraph 'neurolucida x) 839 permutecoords: permutecoords) 827 840 (currentoutputport))))) 828 841 (map (lambda (x) (makepathname ddir (car (stringsplit (cadar x) "#")) "ng")) datamap) 842 (map (lambda (x) (car (stringsplit (cadar x) "#"))) datamap) 829 843 datamap) 830 844 )) 
release/4/neurolucida/tags/1.13/neurolucida.setup
r27733 r27738 9 9 10 10 ; Assoc list with properties for the program: 11 '((version 1.1 2))11 '((version 1.13)) 12 12 ) 13 13 
release/4/neurolucida/trunk/neurolucida.setup
r27733 r27738 9 9 10 10 ; Assoc list with properties for the program: 11 '((version 1.1 2))11 '((version 1.13)) 12 12 ) 13 13
Note: See TracChangeset
for help on using the changeset viewer.