Changeset 31141 in project
 Timestamp:
 07/22/14 11:01:36 (6 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

release/4/picnic/trunk/picnicutils.scm
r31140 r31141 28 28 (requireextension srfi69 datatype matchable vectorlib 29 29 mpi mathh typeclass kdtree randommtzig 30 lalrdriver )30 lalrdriver digraph graphdfs) 31 31 32 32 … … 880 880 (let ((point (car lst))) 881 881 882 (let ((nodeid 883 (preid 882 (let ((nodeid (swcpointid point)) 883 (preid (swcpointpre point))) 884 884 885 (let* ((prepoint (nodeinfo preid))885 (let* ((prepoint (nodeinfo preid)) 886 886 (precoords (swcpointcoords prepoint)) 887 (distance (sqrt (dist2 nodecoords precoords))))887 (distance (sqrt (dist2 nodecoords precoords)))) 888 888 889 889 (addedge! (list nodeid preid distance)) … … 896 896 ) 897 897 898 899 (define (treegraph>genpoints g type) 898 (define (treegraphdistances+segments g) 899 900 (define n ((g 'capacity))) 901 (define distv (makef64vector (+ 1 n) 1.0)) 902 903 (define (traverse es) 904 (if (null? es) distv 905 (matchlet (((i j dist) (car es))) 906 (if (>= (f64vectorref distv j) 0.0) 907 (traverse (cdr es)) 908 (let ((idist (f64vectorref distv i))) 909 (f64vectorset! distv j (+ idist dist)) 910 (let ((distv1 (traverse ((g 'outedges) j)))) 911 (traverse es))) 912 )) 913 )) 914 915 (let ((root 1)) 916 (f64vectorset! distv root 0.0) 917 (traverse ((g 'outedges) root)) 918 distv) 919 ) 920 921 (define (treegraph>genpoints g gdistv gsegv type cellindex) 900 922 901 923 (let ((nodeinfo (g 'nodeinfo)) 902 924 (outedges (g 'outedges))) 903 904 (let recur (( root1) (lst '()))925 926 (let recur ((n 1) (lst '())) 905 927 906 928 (let* ( 907 929 (point (nodeinfo root)) 908 930 (pointtype (swcpointtype point)) 931 (pointpre (swcpointpre point)) 909 932 (proceed? (or (= pointtype type) 910 933 (case (swcpointtype point) … … 914 937 915 938 (if proceed? 916 (let* ((point1 (makegenpoint 917 (swcpointcoords point) 918 parentindex 919 parentdistance 920 segment))) 939 940 (let ( 941 (point1 (makegenpoint 942 (swcpointcoords point) 943 cellindex 944 (f64vectorref gdistv n) 945 (s32vectorref gsegv n))) 946 ) 947 921 948 (fold (lambda (x ax) (recur x ax)) (cons point1 lst) (outedges root))) 949 922 950 lst) 923 951 … … 926 954 927 955 928 (define (loadswc filename type label )956 (define (loadswc filename type label index) 929 957 930 958 (let ((in (openinputfile filename))) … … 932 960 (if (not in) (error 'loadswc "file not found" filename)) 933 961 934 (let* ((lines 962 (let* ( 963 (lines 935 964 (filter (lambda (line) (not (irregexmatch commentpat line))) 936 965 (readlines in))) 966 937 967 (swcdata 938 968 (filtermap … … 948 978 (swcgraph (maketreegraph swcdata label)) 949 979 950 (pointdata (treegraph>genpoints swcgraph type)) 951 952 (pointtree (list>kdtree pointdata)) 980 (dist+segs (treegraphdistances+segments swcgraph)) 981 (pointdata (treegraph>genpoints 982 swcgraph (car dist+segs) (cadr dist+segs) 983 type index)) 984 953 985 ) 954 986 955 (list point tree))987 (list pointdata)) 956 988 )) 957 989
Note: See TracChangeset
for help on using the changeset viewer.