From a0ea857685804735d60f19a166274745d8785e62 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Sun, 29 Jul 2018 19:01:24 +0200 Subject: Update the traversing sheet function --- src/sheet.ml | 164 ++++++++++++++++++++++++++++++++++------------------ src/tree/splay.ml | 5 ++ src/tree/splay.mli | 5 ++ tests/sheet_test.ml | 16 +++-- 4 files changed, 128 insertions(+), 62 deletions(-) diff --git a/src/sheet.ml b/src/sheet.ml index b72786e..4984bde 100755 --- a/src/sheet.ml +++ b/src/sheet.ml @@ -34,70 +34,122 @@ module Raw = struct (** Internaly, we use an array to store the data. Each array as a fixed size of 8×8 cells, and each array is stored in a tree. *) - module Map = PageMap.SplayMap(struct type t = content let default = empty_cell end) + module PageMap = PageMap.SplayMap(struct type t = content let default = empty_cell end) - (** The sheet is a map which always contains evaluated values. When a cell is + (** The sheet is a PageMap which always contains evaluated values. When a cell is updated, all the cell which references this value are also updated. *) - type t = Map.t + type t = PageMap.t - let get_expr id t = (Map.find id t).expr + let get_expr id t = (PageMap.find id t).expr (** Update the value for the given cell. Evaluate the new expression and compare it with the previous value. - @return Some map if the map has been updated + @return Some PageMap if the PageMap has been updated *) let update catalog cell content t = begin - let new_val = Expression.eval content.expr catalog (fun id -> (Map.find id t).value) in + let new_val = Expression.eval content.expr catalog (fun id -> (PageMap.find id t).value) in match content.value with | None -> - (* If the previous value wasn't defined, update the map *) - Some (Map.add cell { content with value = Some new_val } t) + (* If the previous value wasn't defined, update the PageMap *) + Some (PageMap.add cell { content with value = Some new_val } t) | Some old_value -> (* If the previous value was defined, update only if result differs *) if not (ScTypes.Result.(=) new_val old_value) then - Some (Map.add cell { content with value = Some new_val } t) + Some (PageMap.add cell { content with value = Some new_val } t) else - (* If there is no changes, do not update the map *) + (* If there is no changes, do not update the PageMap *) None end - let traverse (f:(cell -> content -> t -> t option)) content (init, t) = begin + let traverse (f:(cell -> content -> t -> t option)) content (id, t) = begin - let rec ts visited t next = begin - if Cell.Set.is_empty next then - Ok (visited, t) + let module M = Hashtbl.Make(struct + type t = cell + let equal c1 c2 = c1 = c2 + let hash (x, y) = (lnot x) + y + end) in + + (* Create a table with each cell and it evaluation order. + Detect cycles and return None if there is any. + *) + let rec _order cache level next : cell array option = + begin match (Cell.Set.is_empty next) with + | true -> + (* Nothing more to do, store the values in an array, and return it. *) + let arr = Array.make (M.length cache) (0, (0, 0)) in + let i = ref 0 in + M.iter (fun id (idx, _) -> Array.set arr (!i) (idx, id); incr i ) cache; + Array.sort (fun ((v1:int), _) ((v2:int), _) -> compare v1 v2) arr; + Some (Array.map (fun (_, cell) -> cell) arr) + + | false -> + let id = Cell.Set.choose next in + + let content = PageMap.find id t in + + let update k = function + | None -> None + | Some level -> + let level' = level + 1 in + begin match M.find_opt cache k with + | None -> M.add cache k (level', Cell.Set.singleton id); + Some level' + | Some (depth, pred) -> + if (Cell.Set.mem id pred) then + (* There is a cycle, break the loop *) + None + else + let pred' = Cell.Set.add id pred in + M.replace cache k (level', pred'); + Some level' + end + in + + (* Update the cache for each sink in the cell *) + match Cell.Set.fold update content.sink level with + | None -> None (* There is a cylce, juste stop *) + | level' -> + (* Then add all the cell to be next set *) + Cell.Set.remove id next + |> Cell.Set.union content.sink + |> _order cache level' + + end in + + let eval (to_update, t) (id) = begin + if not (Cell.Set.mem id to_update) then + (to_update, t) else - let (id:cell) = Cell.Set.choose next in + let content = PageMap.find id t in + match f id content t with + | None -> (to_update, t) + | Some t' -> (Cell.Set.union content.sink to_update, t') + end in - if Cell.Set.mem id init then - Error (visited, t) + (** Traverse all the cells to mark them with an error *) + let cycle_error = Some (ScTypes.Result.Error Errors.Cycle) in + let rec set_error t next = begin + if Cell.Set.is_empty next then + (* Nothing more to do, just return the sheet updated *) + t + else + let id = Cell.Set.choose next in + let content = PageMap.find id t in + let next' = Cell.Set.remove id next in + if content.value = cycle_error then + set_error t next' else - let content = Map.find id t in - let next' = Cell.Set.remove id next - and visited' = Cell.Set.add id visited in - - begin match f id content t with - | None -> - (* The content does not change, we do not update the successors *) - (ts[@tailcall]) visited' t next' - | Some t' -> - let delta = Cell.Set.diff content.sink init in - let next'' = Cell.Set.union next' delta in - - (ts[@tailcall]) visited' t' next'' - end + let t' = PageMap.add id { content with value = cycle_error } t in + set_error t' (Cell.Set.union next' content.sink) end in - begin match ts init t content.sink with - | Ok (visited, t) -> (visited, t) - | Error (visited, t) -> - let cycle_error = Some (ScTypes.Result.Error Errors.Cycle) in - let setErr cell t : t= Map.add cell { content with value = cycle_error } t in - visited, Cell.Set.fold setErr visited t - end + match _order (M.create 16) (Some 0) (Cell.Set.singleton id) with + | None -> Cell.Set.empty, (set_error t (Cell.Set.singleton id)) + | Some arr -> Array.fold_left eval ((Cell.Set.add id content.sink), t) arr end + (** Remove the cell from the sheet *) let remove_element (id:cell) t : t * content option = begin @@ -105,18 +157,18 @@ module Raw = struct If the sources is not referenced anywhere, and is Undefined, remove it *) let remove_ref cell t = begin - try let c = Map.find cell t in + try let c = PageMap.find cell t in (* Remove all the refs which points to the removed cell *) let sink' = Cell.Set.filter ((<>) id) c.sink in if Cell.Set.is_empty sink' && not (Expression.is_defined c.expr) then ( - Map.remove cell t ) + PageMap.remove cell t ) else - Map.add cell {c with sink = sink'} t + PageMap.add cell {c with sink = sink'} t with Not_found -> t end in begin try - let c = Map.find id t in + let c = PageMap.find id t in let t' = (** Remove the references from each cell pointed by the expression *) let sources = Expression.collect_sources c.expr in @@ -127,10 +179,10 @@ module Raw = struct let sink' = Cell.Set.filter ((<>) id) c.sink in (** If there is no more references on the cell, remove it *) if Cell.Set.is_empty sink' then - Map.remove id t', None + PageMap.remove id t', None else ( let c = { empty_cell with sink = sink' } in - Map.add id c t', (Some c) + PageMap.add id c t', (Some c) ) with Not_found -> t, None end @@ -141,7 +193,7 @@ module Raw = struct | t, None -> Cell.Set.empty, t | t, Some content -> (** Update all the successors *) - traverse (update catalog) content (Cell.Set.singleton id, t) + traverse (update catalog) content (id, t) end let add_element catalog id content_builder t = begin @@ -151,10 +203,10 @@ module Raw = struct *) let add_ref cell t = begin let c = - try Map.find cell t + try PageMap.find cell t with Not_found -> empty_cell in let c' = { c with sink = Cell.Set.add id c.sink} in - Map.add cell c' t + PageMap.add cell c' t end in (* Remove the cell and update all the sink. *) @@ -166,12 +218,12 @@ module Raw = struct let content = content_builder cell' t' in let sources = Expression.collect_sources content.expr in - let updated = Map.add id content t' + let updated = PageMap.add id content t' |> Cell.Set.fold add_ref sources in (** Update the value for each sink already evaluated *) - traverse (update catalog) content (Cell.Set.singleton id, updated) + traverse (update catalog) content (id, updated) end let add id expression catalog t = begin @@ -181,7 +233,7 @@ module Raw = struct let f cell t = begin { cell with expr = expression ; - value = Some (Expression.eval expression catalog (fun id -> (Map.find id t).value)) } + value = Some (Expression.eval expression catalog (fun id -> (PageMap.find id t).value)) } end in add_element catalog id f t end @@ -191,13 +243,13 @@ module Raw = struct let f cell t = { cell with expr = expr ; - value = Some (Expression.eval expr catalog (fun id -> (Map.find id t).value)) + value = Some (Expression.eval expr catalog (fun id -> (PageMap.find id t).value)) } in add_element catalog id f t end let get_sink id t = - try (Map.find id t).sink + try (PageMap.find id t).sink with Not_found -> Cell.Set.empty end @@ -245,7 +297,7 @@ let yank selected t = begin let origin = shift (0, 0) in let _yank (count, extracted) cell = begin let content = - try let content = (Raw.Map.find cell (!t).data) in + try let content = (Raw.PageMap.find cell (!t).data) in { content with Raw.expr = Expression.shift origin content.Raw.expr } with Not_found -> Raw.empty_cell in @@ -288,7 +340,7 @@ let add ~history expression id t = begin end let create catalog = ref { - data = Raw.Map.empty; + data = Raw.PageMap.empty; history = []; yank = []; catalog = catalog @@ -296,7 +348,7 @@ let create catalog = ref { (** Fold over each defined value *) let fold f a t = begin - Raw.Map.fold (fun key content a -> + Raw.PageMap.fold (fun key content a -> match content.Raw.value with | None -> a | Some x -> @@ -305,6 +357,6 @@ let fold f a t = begin end let get_cell id t = begin - let cell = Raw.Map.find id (!t).data in + let cell = Raw.PageMap.find id (!t).data in cell.expr, cell.value, cell.sink end diff --git a/src/tree/splay.ml b/src/tree/splay.ml index de7d441..dd1f65d 100644 --- a/src/tree/splay.ml +++ b/src/tree/splay.ml @@ -180,6 +180,11 @@ module Make (El : KEY) = struct _fold [] init !t end + let choose (T tree) = begin match (_subtree_minimum !tree) with + | Leaf -> raise Not_found + | Node (left, (key, value), right) -> C (key, value) + end + let repr formatter (T t) = begin let repr_edge from formatter dest = begin diff --git a/src/tree/splay.mli b/src/tree/splay.mli index a640075..60d067b 100755 --- a/src/tree/splay.mli +++ b/src/tree/splay.mli @@ -48,6 +48,11 @@ module Make (El : KEY) : sig val fold: ('a -> container -> 'a) -> 'a -> t -> 'a + (** Return one element of the given tree, or raise Not_found if the tree is + empty. Which element is chosen is unspecified, but equal elements will be + chosen for equal trees. *) + val choose: t -> container + (** Represent the content in dot syntax *) val repr: Format.formatter -> t -> unit diff --git a/tests/sheet_test.ml b/tests/sheet_test.ml index db09f37..7c5da64 100755 --- a/tests/sheet_test.ml +++ b/tests/sheet_test.ml @@ -75,7 +75,7 @@ let test_create_direct_cycle ctx = begin ignore @@ Sheet.add ~history:false (Expression.load @@ u"=B2 + 1") (2,2) s; let _, result, _ = Sheet.get_cell (2, 2) s in - let expected = Some (ScTypes.Result.Error Errors.TypeError) in + let expected = Some (ScTypes.Result.Error Errors.Cycle) in assert_equal ~msg:(_msg ~expected ~result) @@ -165,7 +165,7 @@ let test_update_succs1 ctx = begin let result = Sheet.add ~history:false (Expression.load @@ u"=2") (1,1) s in (* All the cells are updated by the change *) - let expected = Cell.Set.of_list [(1,1); (1, 2); (2,2)] in + let expected = Cell.Set.of_list [(1, 2); (1, 1); (2, 2)] in let msg = Printf.sprintf "Expected %s but got %s" (UTF8.raw_encode @@ Tools.String.print_buffer Cell.Set.printb expected) @@ -186,9 +186,13 @@ let test_update_succs2 ctx = begin let result = Sheet.add ~history:false (Expression.load @@ u"=2") (1,1) s in (* Only (1, 1) is updated ; (2, 2) does not change, neither (2, 2) *) - let expected = Cell.Set.of_list [(1,1)] in + let expected = Cell.Set.of_list [(1,2); (1,1)] in - assert_equal + let msg = Printf.sprintf "Expected %s but got %s" + (UTF8.raw_encode @@ Tools.String.print_buffer Cell.Set.printb expected) + (UTF8.raw_encode @@ Tools.String.print_buffer Cell.Set.printb result) in + + assert_equal ~msg expected result end @@ -232,10 +236,10 @@ let tests = "sheet_test">::: [ "test_ref2" >:: test_create_ref_2; "test_cycle1" >:: test_create_direct_cycle; "test_recover_cycle" >:: test_recover_from_cycle; - (*"test_cycle2" >:: test_create_indirect_cycle;*) + "test_cycle2" >:: test_create_indirect_cycle; "test_cycle3" >:: test_check_cycle3; "test_delete" >:: test_delete; "test_update_succs1" >:: test_update_succs1; - (*"test_update_succs2" >:: test_update_succs2;*) + "test_update_succs2" >:: test_update_succs2; "test_paste_undo" >:: test_paste_undo; ] -- cgit v1.2.3