[q-lang-cvs] qcalc qcalc.q,1.124,1.125

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/q-lang/qcalc
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv30332

Modified Files:
	qcalc.q 
Log Message:
eliminate the obsolete topsort evaluation algorithm, bugfixes and optimizations

Index: qcalc.q
===================================================================
RCS file: /cvsroot/q-lang/qcalc/qcalc.q,v
retrieving revision 1.124
retrieving revision 1.125
diff -C2 -d -r1.124 -r1.125
*** qcalc.q	10 Nov 2007 22:13:14 -0000	1.124
--- qcalc.q	10 Nov 2007 22:49:07 -0000	1.125
***************
*** 444,448 ****
  		      OLD = filter (deltacmp NEW_EVAL) OLD,
  		      NEW = filter (deltacmp OLD_EVAL) NEW,
! 		      OLD = filter (neg.member (hdict NEW)) OLD,
  		      OLD = map fst OLD;

--- 444,448 ----
  		      OLD = filter (deltacmp NEW_EVAL) OLD,
  		      NEW = filter (deltacmp OLD_EVAL) NEW,
! 		      OLD = filter (neg $ member (hdict NEW).fst) OLD,
  		      OLD = map fst OLD;

***************
*** 3007,3021 ****
  /* Process cell values after edits or after loading a new file. */

! process_all	= do flag U || compute_all V
! 		    where (V,U) = eval_list $ sort indexcmp $ keys $ get CELLS
  		    if check_interp;

  doprocess (I,J)	= insert_cells ((I,J),true) ||
  		  clear_cell (I,J) ||
- 		  // flag "bad" cells (cyclic computations)
- 		  do flag U ||
  		  // do the necessary reevaluations
  		  if check_interp then compute (I,J) V
! 		    where (V,U) = eval_list (I,J),
  		      V = dropwhile (<>(I,J)) V;

--- 3007,3018 ----
  /* Process cell values after edits or after loading a new file. */

! process_all	= compute_all $ eval_list $ sort indexcmp $ keys $ get CELLS
  		    if check_interp;

  doprocess (I,J)	= insert_cells ((I,J),true) ||
  		  clear_cell (I,J) ||
  		  // do the necessary reevaluations
  		  if check_interp then compute (I,J) V
! 		    where V = eval_list (I,J),
  		      V = dropwhile (<>(I,J)) V;

***************
*** 3033,3047 ****
  		    where S = qt TABLE "text" (I,J),
  		      _ = delete_eval (I,J),
! 		      (V,U) = eval_list (I,J);

  process_gui (I,J) X
! 		= // flag "bad" cells (cyclic computations)
! 		  do flag U ||
! 		  // set the new value in the inferior process
  		  // (check whether the value is actually transferable)
  		  if checkval X then submit_val (I,J) X ||
  		  // do the necessary reevaluations
  		  if check_interp then compute (I,J) V
! 		    where (V,U) = eval_list (I,J),
  		      V = dropwhile (=(I,J)) $ dropwhile (<>(I,J)) V,
  		      X = gui_getval X;
--- 3030,3042 ----
  		    where S = qt TABLE "text" (I,J),
  		      _ = delete_eval (I,J),
! 		      V = eval_list (I,J);

  process_gui (I,J) X
! 		= // set the new value in the inferior process
  		  // (check whether the value is actually transferable)
  		  if checkval X then submit_val (I,J) X ||
  		  // do the necessary reevaluations
  		  if check_interp then compute (I,J) V
! 		    where V = eval_list (I,J),
  		      V = dropwhile (=(I,J)) $ dropwhile (<>(I,J)) V,
  		      X = gui_getval X;
***************
*** 3062,3070 ****
  		    otherwise;

! process_sel W	= do flag U || if check_interp then compute W V
  		    where (C,E) = foldl process1 (get CELLS,get EVAL) W,
  		      _ = set_cells C || set_eval E,
  		      W = map (flip (flip sub 0) 1) W,
! 		      (V,U) = eval_list W
  		    if not null W and then check_interp;

--- 3057,3065 ----
  		    otherwise;

! process_sel W	= if check_interp then compute W V
  		    where (C,E) = foldl process1 (get CELLS,get EVAL) W,
  		      _ = set_cells C || set_eval E,
  		      W = map (flip (flip sub 0) 1) W,
! 		      V = eval_list W
  		    if not null W and then check_interp;

***************
*** 3087,3130 ****
  		    otherwise;

! process_sel2 W	= do flag U || if check_interp then compute2 W V
  		    where //_ = printf "*** pending updates: %s\n" $ str W,
  		      (C,E) = foldl process2 (get CELLS,get EVAL) W,
  		      _ = set_cells C || set_eval E,
  		      W = map (flip (flip sub 0) 1) W,
! 		      (V,U) = eval_list W
  		    if not null W and then check_interp;

  clear_sel W	= do clear_cell W || compute W V
  		    where _ = delete_cells W || delete_eval W,
! 		      (V,U) = eval_list W
  		    if not null W and then check_interp;

! /* Compute the evaluation order. We now provide two alternative routines,
!    depth-first search (more precisely, the reversal of a depth-first
!    postorder) starting from a given node or list of nodes (which works ok with
!    cyclic dependencies, but may consider them in an apparently random order),
!    and global topological sort (which refuses to order cyclic computations).
!    In any case, the result is a pair of two lists V and U. V contains the
!    indices of cells in the order in which they should be evaluated. U contains
!    the indices of "bad" cells which is always empty for the depth-first order,
!    and for topsort contains the nodes which couldn't be ordered because they
!    are connected to some cyclic computation. The topological sort used in
!    previous cvs versions is now being phased out in favour of depth-first
!    search, which is a little more efficient for incremental computations and
!    handles a greater variety of usage cases, but is also less predictable if
!    cyclic computations have to be performed. */

  eval_list (I,J)	= eval_list [(I,J)];
  eval_list V	= dfs_list V;
- //eval_list V	= topsort_list;
- 
- /* Depth-first postorder. */

! dfs_list []	= ([],[]);
! dfs_list V	= //printf "DFS: %s\n" $ str V ||
! 		  (V,[])
  		    where V = filter (member (get EVAL)) $ dfs V;

! dfs V		= Xs where (_,Xs) = foldl search (emptyhdict,[]) V;
  search (V,Xs) X	= (V,Xs) if member V X;
  		= (V,[X|Xs])
--- 3082,3117 ----
  		    otherwise;

! process_sel2 W	= if check_interp then compute2 W V
  		    where //_ = printf "*** pending updates: %s\n" $ str W,
  		      (C,E) = foldl process2 (get CELLS,get EVAL) W,
  		      _ = set_cells C || set_eval E,
  		      W = map (flip (flip sub 0) 1) W,
! 		      V = eval_list W
  		    if not null W and then check_interp;

  clear_sel W	= do clear_cell W || compute W V
  		    where _ = delete_cells W || delete_eval W,
! 		      V = eval_list W
  		    if not null W and then check_interp;

! /* Compute the evaluation order. The present implementation uses a depth-first
!    search algorithm (more precisely, the reversal of a depth-first postorder)
!    starting from a given node or list of nodes. This works ok with cyclic
!    dependencies, but may consider them in an apparently random order. (If you
!    take a closer look you will find that the order is not completely random,
!    but always considers forward edges in the dependency graph in the order of
!    the target (dependent) cells, where cells are ordered first by their row,
!    then by their column indices.) The result is a list V containing the
!    indices of cells in the order in which they should be evaluated. */

  eval_list (I,J)	= eval_list [(I,J)];
  eval_list V	= dfs_list V;

! dfs_list []	= [];
! dfs_list V	= //if not null V then printf "DFS: %s\n" $ str V ||
! 		  V
  		    where V = filter (member (get EVAL)) $ dfs V;

! dfs V		= Xs where (_,Xs) = foldl search (emptyhdict,[]) $ reverse V;
  search (V,Xs) X	= (V,Xs) if member V X;
  		= (V,[X|Xs])
***************
*** 3133,3174 ****
  		= (V,[X|Xs]) otherwise;

- /* Topological order. */
- 
- topsort_list	= (V,U)
- 		    where (KEYS,VALS) = unzip (list (get EVAL)),
- 		      NODE_NUM = hdict (zip KEYS [0..#KEYS-1]),
- 		      ADJ = map (filter (member (get EVAL)).trd) VALS,
- 		      ADJ = map (list.set.map (NODE_NUM!)) ADJ,
- 		      (V,U) = topsort ADJ,
- 		      V = map (KEYS!) V, U = map (KEYS!) U;
- 
- /* Perform a topological sort on a graph given by its adjacency list. Returns
-    a pair (V,U) where V is a maximal topological order and U are the remaining
-    nodes which couldn't be ordered as they are connected to cycles in the
-    graph. */
- 
- /* FIXME: This is a rather simplistic O(N^2) implementation, must do something
-    more efficient here. */
- 
- topsort ADJ	= topsort2 [] (leaves G) G
- 		    where G = zip [0..#ADJ-1] ADJ;
- 
- topsort2 V [] G	= (reverse V,map fst G);
- topsort2 V [X|Xs] G
- 		= topsort2 [X|V] (merge Xs (leaves G)) G
- 		    where G = remove G X;
- 
- merge [] Ys	= Ys;
- merge Xs []	= Xs;
- merge [X|Xs] [Y|Ys]
- 		= [X|merge Xs [Y|Ys]] if X<Y;
- 		= [Y|merge [X|Xs] Ys] if X>Y;
- 		= [X|merge Xs Ys] otherwise;
- 
- leaves G	= map fst (filter (null.snd) G);
- 
- remove G X	= zip V (map (filter (<>X)) E)
- 		    where (V,E) = unzip (filter ((<>X).fst) G);
- 
  /* Inferior Q process. *****************************************************/

--- 3120,3123 ----