Update of /cvsroot/q-lang/qcalc
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv5226
Modified Files:
qcalc.q
Log Message:
optimization of dfs routine
Index: qcalc.q
===================================================================
RCS file: /cvsroot/q-lang/qcalc/qcalc.q,v
retrieving revision 1.117
retrieving revision 1.118
diff -C2 -d -r1.117 -r1.118
*** qcalc.q 9 Nov 2007 23:11:40 -0000 1.117
--- qcalc.q 10 Nov 2007 01:12:14 -0000 1.118
***************
*** 3066,3104 ****
dfs_list V = //printf "reverse dfs postorder: %s\n" $ str V ||
(V,[])
! where // build a dict mapping cell indices to node numbers
! ALL_CELLS = foldl insert (get CELLS) $
! map (flip pair true) V,
! ALL_KEYS = keys ALL_CELLS,
! N = #ALL_KEYS, NODES = [0..N-1],
! NODE_NUM = hdict (zip ALL_KEYS NODES),
! // build a dictionary of dependencies
! (KEYS,VALS) = unzip (list (get EVAL)),
! KEYS = map (NODE_NUM!) KEYS,
! VALS = map (map (NODE_NUM!).
! filter (member NODE_NUM).trd) VALS,
! D = mkdict [] NODES,
! D = foldl insert D $ zip KEYS VALS,
! // compute the reversal of the dependencies graph
! ADJ = cat $ zipwith rev_edges NODES $ vals D,
! D = dict $ zip NODES $ reflist $ mklist emptyset N,
! _ = do (add_edge D) ADJ,
! ADJ = map (list.get) (vals D),
! // perform the depth-first traversal
! V = map (NODE_NUM!) V,
! V = dfs ADJ V,
! V = map (ALL_KEYS!) V,
// determine the list of cells to be evaluated
V = filter (member (get EVAL)) V;
! rev_edges X Ys = map (flip pair X) Ys;
!
! add_edge D (X,Y)
! = D!X := insert (D!!X) Y;
!
! dfs ADJ V = Xs where (_,Xs) = foldl (search ADJ) (emptyset,[]) V;
! search ADJ (V,Xs) X
= (V,Xs) if member V X;
= (V,[X|Xs])
! where (V,Xs) = foldl (search ADJ) (insert V X,Xs) (ADJ!X);
/* Topological order. */
--- 3066,3108 ----
dfs_list V = //printf "reverse dfs postorder: %s\n" $ str V ||
(V,[])
! where // create the dependencies graph
! (K,U,E) = dfs_graph V, V = map (U!) V,
! // traverse it
! V = dfs E V, V = map (K!) V,
// determine the list of cells to be evaluated
V = filter (member (get EVAL)) V;
! dfs E V = Xs where (_,Xs) = foldl (search E) (emptyset,[]) V;
! search E (V,Xs) X
= (V,Xs) if member V X;
= (V,[X|Xs])
! where (V,Xs) = foldl (search E) (insert V X,Xs) (E!X);
!
! // create the depedencies graph for dfs traversal
!
! dfs_graph V = (KEYS,V,E)
! where // create a node numbering
! CELLS = foldl insert (get CELLS) $
! map (flip pair true) V,
! KEYS = keys CELLS, N = [0..#KEYS-1],
! V = hdict (zip KEYS N),
! // collect the backward edges
! E = sort edgescmp $ cat $
! map (make_edges V) $ list $ get EVAL,
! (E,_) = foldl group_edges ([],E) N,
! E = reverse E;
!
! group_edges (A,E) N
! = ([X|A],E)
! where X = map snd $ takewhile ((=N).fst) E,
! E = dropwhile ((=N).fst) E;
!
! make_edges V (I,J;_,_,K)
! = map (flip pair X) $ filter isint $ map (V!) K
! where X:Int = V!(I,J);
! = [] otherwise;
!
! edgescmp (I1,J1) (I2,J2)
! = (I1<I2) or else (I1=I2) and then (J1<J2);
/* Topological order. */
|
