Skip to content

Commit

Permalink
Merge pull request #3 from Incubaid/refa-index_z
Browse files Browse the repository at this point in the history 
removed Top and Loc constructors from index_z
  • Loading branch information
@toolslive
toolslive committed Apr 18, 2013
2 parents 96e7ca8 + 38e6f00 commit 89dd04a
Show file tree
Hide file tree
Showing 3 changed files with 89 additions and 120 deletions.
25 changes: 13 additions & 12 deletions src/index_test.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,23 +22,24 @@ open Indexz
open OUnit
open Base


let t_neighbours () =
let z = Loc ((out 0 7, [("j", out 0 15); ("d", out 0 14)]), []) in
let z = (out 0 7, [("j", out 0 15); ("d", out 0 14)], []) in
let nb = Indexz.neighbours z in
OUnit.assert_equal (NL (out 0 14)) nb

let t_neighbours2 () =
let z = Loc ((out 0 37,["g", out 0 21]),["m", out 0 31; "t", out 0 32]) in
let z = (out 0 37,["g", out 0 21],["m", out 0 31; "t", out 0 32]) in
let nb = Indexz.neighbours z in
OUnit.assert_equal (N2(out 0 37, out 0 31)) nb

let t_neighbours3 () =
let z = Loc ((out 0 0,["m", out 0 1; "g", out 0 2]),["t", out 0 3]) in
let z = (out 0 0,["m", out 0 1; "g", out 0 2],["t", out 0 3]) in
let nb = Indexz.neighbours z in
OUnit.assert_equal (N2(out 0 2,out 0 3)) nb

let t_suppress () =
let z = Loc ((out 0 7, [("j", out 0 15); ("d", out 0 14)]), []) in
let z = (out 0 7, [("j", out 0 15); ("d", out 0 14)], []) in
let nb = Indexz.neighbours z in
match nb with
| NL (Outer (Spindle 0, Offset 14)) ->
Expand All @@ -47,7 +48,7 @@ let t_suppress () =
| _ -> failwith "should be NL 14"

let t_suppress2 () =
let z = Loc ((out 0 7,["d", out 0 8]),[]) in
let z = (out 0 7,["d", out 0 8],[]) in
let nb = Indexz.neighbours z in
match nb with
| NL (Outer (Spindle 0, Offset 7)) ->
Expand All @@ -56,24 +57,24 @@ let t_suppress2 () =
| _ -> failwith "should be NL 7"

let t_suppress3 () =
let z = Loc ((out 0 0,["m", out 0 1; "g", out 0 2]),["t", out 0 3]) in
let z = (out 0 0,["m", out 0 1; "g", out 0 2],["t", out 0 3]) in
let r = Indexz.suppress L (out 0 4) (Some "q") z in
let () = Printf.printf "r = %s\n" (iz2s r) in
let e = Loc ((out 0 0,["g", out 0 4]),["q", out 0 3]) in
let e = (out 0 0,["g", out 0 4],["q", out 0 3]) in
OUnit.assert_equal ~printer:iz2s e r;
()
let t_suppress4() =
let z = Loc ((out 0 78, [("key_12", out 0 79)]), [("key_16", out 0 95)]) in
let z = (out 0 78, [("key_12", out 0 79)], [("key_16", out 0 95)]) in
let r = Indexz.suppress L (out 0 98) (Some "key_15") z in
let e = Top (out 0 98, ["key_15", out 0 95]) in
let e = make_indexz (out 0 98, ["key_15", out 0 95]) in
OUnit.assert_equal ~printer:iz2s e r

let t_split () =
let d = 2
and lpos = out 0 21
and sep = "q"
and rpos = out 0 22
and z = Loc ((out 0 7, [("j", out 0 18); ("d", out 0 14)]), [])
and z = (out 0 7, [("j", out 0 18); ("d", out 0 14)], [])
in
let left, _ , _ = Indexz.split d lpos sep rpos z in
OUnit.assert_equal ~printer:index2s (out 0 7, ["d",out 0 14]) left
Expand All @@ -83,14 +84,14 @@ let t_split2() =
and lpos = out 0 21
and sep = "j"
and rpos = out 0 22
and z = Loc ((out 0 7, [("d", out 0 18)]), [("q", out 0 15)]) in
and z = (out 0 7, [("d", out 0 18)], [("q", out 0 15)]) in
let left,_,right = Indexz.split d lpos sep rpos z in
let printer = index2s in
OUnit.assert_equal ~printer (out 0 7,["d", out 0 21]) left;
OUnit.assert_equal ~printer (out 0 22,["q",out 0 15]) right

let t_replace () =
let z = Loc ((out 0 7, [("d", out 0 14)]), [("m", out 0 15)]) in
let z = (out 0 7, [("d", out 0 14)], [("m", out 0 15)]) in
let index = Indexz.replace (out 0 18) z in
OUnit.assert_equal ~printer:index2s index (out 0 7,("d",out 0 18) :: ("m",out 0 15)::[])

Expand Down
156 changes: 61 additions & 95 deletions src/indexz.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,91 +20,69 @@
open Base
open Index

type index_z =
| Top of index
| Loc of ((pos * (kp list)) * (kp list))

let iz2s = function
| Top (p0, kps) -> Printf.sprintf "Top (%s,%s)" (pos2s p0) (kpl2s kps)
| Loc ((p0,c),t) -> Printf.sprintf "Loc ((%s,%s),%s)" (pos2s p0) (kpl2s c) (kpl2s t)
type index_z = pos * (kp list) * (kp list)

let make_indexz (p0, kps) = Top ((p0, kps))
let iz2s (p0, c, t) = Printf.sprintf "(%s,%s,%s)" (pos2s p0) (kpl2s c) (kpl2s t)

let make_indexz (p0, kps) = (p0, [], kps)

let find_set index k =
let rec loop z =
match z with
| Top (_,[]) -> z
| Top (_ , (k0, _) :: _) when k <= k0 -> z
| Top ((p0, h :: t)) ->
let pre = p0, [h] in
let z' = Loc (pre, t) in
loop z'

| Loc (_, []) -> z
| Loc (_ , (ki,_) :: _) when k <= ki -> z
| Loc ( (p0,c) , ((_,_) as h :: t)) ->
let pre = p0, (h :: c) in
let z' = Loc (pre, t) in
| (_, _, []) -> z
| (_, _, (ki, _) :: _) when k <= ki -> z
| (p0, c, h :: t) ->
let z' = (p0, h :: c, t) in
loop z'
in loop (Top index)
in loop (make_indexz index)


let pos = function
| Top ( p0,_) -> p0
| Loc ((_, (_,pi) ::_) , _ ) -> pi
| Loc ((_,[]),_) -> failwith "illegal Loc"
| (p0, [], _) -> p0
| (_, (_, pi) :: _, _) -> pi

let replace pos z =
match z with
| Top (_, kps) -> (pos,kps)
| Loc ((p0, (k,_) :: c ), t ) -> (p0, List.rev_append c ((k,pos) :: t))
| Loc ((_,[]),_) -> failwith "illegal Loc"
| (_, [], kps) -> (pos, kps)
| (p0, (k, _) :: c, t) -> (p0, List.rev_append c ((k,pos) :: t))


let max d z =
let z_size = match z with
| Top (_,kps) -> List.length kps
| Loc ((_,c),t) -> List.length c + List.length t
| (_, c, t) -> List.length c + List.length t
in
z_size = 2 * d - 2

let borrowed_right lpos sep rpos = function
| Top (_, _::t) -> Top (lpos,(sep,rpos) ::t)
| Top (_,[]) -> failwith "illegal Top"
| Loc (_,_) -> failwith "illegal Loc"
| (_, [], _::t) -> (lpos, [], (sep, rpos)::t)
| (_, _, _) -> failwith "illegal borrowed_right"


let borrowed_left lpos sep rpos = function
| Loc((_, [_]),t) -> Loc ((lpos, [sep,rpos]),t)
| Loc((p0, _ :: (ky,_) :: c),t) -> Loc ((p0,(sep,rpos)::(ky,lpos)::c), t)
| Top (_,_)
| Loc ((_,[]),_) as z ->
| (_, [_], t) -> (lpos, [sep, rpos], t)
| (p0, _ :: (ky,_) :: c, t) -> (p0, (sep,rpos)::(ky,lpos)::c, t)
| (_, [], _) as z ->
let s= Printf.sprintf "indexz_borrowed_left %s %s %s z=%s\n%!"
(pos2s lpos) sep (pos2s rpos) (iz2s z) in
failwith s

let can_go_right = function
| Top (_, _ :: _) -> true
| Loc ((_,_), _:: _) -> true
| Top (_,[]) -> false
| Loc ((_,_),[]) -> false
| (_, _, _ :: _) -> true
| (_, _, []) -> false

let replace_right new_sep = function
| Top (p0,(_,p1)::t) -> Top (p0, (new_sep,p1)::t)
| Loc ((p0,c), (_,pr)::t) -> Loc ((p0,c), (new_sep,pr) :: t)
| Top (_,[])
| Loc ((_,_),[]) -> failwith "cannot replace right"
| (p0, c, (_, pr) :: t) -> (p0, c, (new_sep, pr) :: t)
| (_, _, []) -> failwith "cannot replace right"


let indexz_right = function
| Top (p0 ,h :: t) -> Loc ((p0,[h]),t)
| Loc ((p0, c), h :: t) -> Loc ((p0, h :: c), t)
| Top (_,[])
| Loc ((_,_),[]) as z -> let s = Printf.sprintf "cannot go right: %s\n" (iz2s z) in failwith s
| (p0, c, h :: t) -> (p0, h :: c, t)
| (_, _, []) as z -> let s = Printf.sprintf "cannot go right: %s\n" (iz2s z) in failwith s

let indexz_left = function
| Loc ((p0, h :: c), t) -> Loc ((p0, c), h::t)
| Top _
| Loc ((_,[]),_) as z -> let s = Printf.sprintf "cannot go left: %s\n" (iz2s z) in failwith s
| (p0, h :: c, t) -> (p0, c, h :: t)
| (_, [], _) as z -> let s = Printf.sprintf "cannot go left: %s\n" (iz2s z) in failwith s


type merger = L | R
Expand All @@ -114,47 +92,39 @@ let separator d z =
| L ->
begin
match z with
| Loc ((_,(kc,_)::_),_) -> kc
| Top _ -> failwith "no left"
| Loc ((_,[]),_) -> failwith "illegal Loc"
| (_, (kc, _)::_, _) -> kc
| (_, [], _) -> failwith "no left"
end
| R ->
begin
match z with
| Loc ( (_,_), (kt,_)::_) -> kt
| Top (_, (k0,_):: _) -> k0
| Top (_,[])
| Loc ((_,_),[]) -> let s = Printf.sprintf "indexz_separator R (%s)\n" (iz2s z) in failwith s
| (_, _, (kt, _) :: _) -> kt
| (_, _, []) -> failwith "no right"
end

let suppress d pn sep_o z =
let maybe_replace_sep sep sep_o =
match sep_o with
| None -> sep
| Some sep -> sep
in
match d with
| R ->
begin
match z with
| Top (_, _::t) -> Top (pn,t)
| Loc ((p0, (kc,_) :: c), _::t) -> Loc ((p0, (kc,pn):: c) , t)
| Top (_,[])
| Loc ((_,_),_) -> failwith "cannot suppress"
| (_, [], _ :: t) -> (pn, [], t)
| (p0, (kc, _) :: c, _ :: t) -> (p0, (kc, pn)::c, t)
| (_, _, _) -> failwith "cannot suppress"
end
| L ->
let new_t = function
| [] -> []
| (kx, px) :: t ->
let new_sep = match sep_o with
| None -> kx
| Some sep -> sep in
(new_sep, px) :: t in
match z with
| Loc ((_,[_]),[]) -> Top (pn,[])
| Loc ((_,[_]), (kx,px)::t) ->
let new_sep = maybe_replace_sep kx sep_o in
Top (pn, ((new_sep,px)::t))
| Loc ((p0, _::(kr,_)::c),[]) -> Loc ((p0, (kr,pn)::c), [])
| Loc ((p0, _ :: (kr,_)::c),(kx,px):: t) ->
let new_sep = maybe_replace_sep kx sep_o in
Loc ((p0, (kr,pn)::c), (new_sep,px) :: t)
| Top _ | Loc ((_,[]),_) ->
let s = Printf.sprintf "suppress L %s z=%s" (pos2s pn) (iz2s z) in failwith s

| (_, [_], t) -> (pn, [], new_t t)
| (p0, _ :: (kr, _) :: c, t) -> (p0, (kr, pn) :: c, new_t t)
| (_, [], _) ->
let s = Printf.sprintf "suppress L %s z=%s" (pos2s pn) (iz2s z) in
failwith s

type neighbours =
| NR of pos
Expand All @@ -164,22 +134,21 @@ type neighbours =


let neighbours = function
| Top (_, (_,p1) :: _) -> NR p1
| Loc ((p0, [_]), []) -> NL p0
| Loc ((p0, [_]), (_,pr)::_) -> N2 (p0,pr)
| Loc ((_, _ :: (_,pl) ::_), [] ) -> NL pl
| Loc ((_, _ :: (_,pl) ::_), (_,pr):: _) -> N2(pl,pr)
| Top (_,[]) | Loc ((_,[]),_) as z ->
let s = Printf.sprintf "index_neighbours %s\n" (iz2s z) in failwith s
| (_, [], (_, p1) :: _) -> NR p1
| (p0, [_], []) -> NL p0
| (p0, [_], (_, pr) :: _) -> N2 (p0, pr)
| (_, _ :: (_, pl) :: _, []) -> NL pl
| (_, _ :: (_, pl) :: _, (_, pr) :: _) -> N2 (pl, pr)
| (_, [], _) as z ->
let s = Printf.sprintf "index_neighbours %s\n" (iz2s z) in
failwith s

let close = function
| Top index -> index
| Loc ((p0,c), t) -> p0, (List.rev c) @ t
| (p0, c, t) -> p0, List.rev_append c t

let balance d z =
let move, n = match z with
| Top (_,_) -> indexz_right, d
| Loc ((_,c), r) ->
| (_, c, r) ->
let cs = List.length c
and rs = List.length r
in
Expand All @@ -197,23 +166,20 @@ exception IZ of index_z

let insert lpos sep rpos z =
match z with
| Top ((_,t)) -> Top (lpos, ((sep,rpos) :: t))
| Loc ((p0,(k,_)::c),t) -> Loc ((p0, (sep,rpos):: (k,lpos) :: c), t)
| Loc ((_,[]),_) -> failwith "illegal loc"
(* | z -> let s = Printf.sprintf "indexz_insert %i %s %i %s" lpos sep rpos (iz2s z) in failwith s *)
| (_, [], t) -> (lpos, [], (sep, rpos) :: t)
| (p0, (k, _) :: c, t) -> (p0, (sep, rpos) :: (k, lpos) :: c, t)


let split d lpos sep rpos z =
let z1 = insert lpos sep rpos z in
let z2 = balance d z1 in
let r =
match z2 with
| Loc ((p0, (k,p)::c), t) ->
| (p0, (k, p) :: c, t) ->
let left = p0, List.rev c in
let right = p, t in
left, k,right
| Loc ((_,[]),_) -> failwith "illegal loc"
| Top _ as z ->
| (_, _, _) as z ->
let s = Printf.sprintf "indexz_split %s %s %s %s=> %s \n"
(pos2s lpos) sep (pos2s rpos) (iz2s z) (iz2s z2)
in
Expand Down
28 changes: 15 additions & 13 deletions src/indexz_test.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,29 +24,29 @@ open Pos
let assert_balanced z =
let m = Printf.sprintf "not balanced: %s" (iz2s z) in
match z with
| Loc ((_,l),r) ->
| (_, (_::_ as l), r) ->
let ls = List.length l in
let rs = List.length r in
let b = (ls = rs + 1) in
OUnit.assert_bool m b
| Top _ -> OUnit.assert_bool m false
| (_, [], _) -> OUnit.assert_bool m false

let t_balance() =
let d = 2 in
let z = Loc ((out 0 7,["q", out 0 22; "j", out 0 21; "d", out 0 14]),[]) in
let z = (out 0 7,["q", out 0 22; "j", out 0 21; "d", out 0 14],[]) in
let z' = Indexz.balance d z in
assert_balanced z'


let t_balance2 () =
let d = 2 in
let z = Top (out 0 0,["d", out 0 1; "j", out 0 2; "q", out 0 3]) in
let z = make_indexz (out 0 0,["d", out 0 1; "j", out 0 2; "q", out 0 3]) in
let z' = Indexz.balance d z in
assert_balanced z'

let t_balance3 () =
let d = 3 in
let z = Top (out 0 0,["d", out 0 1;
let z = make_indexz (out 0 0,["d", out 0 1;
"j", out 0 2;
"q", out 0 3;
"t", out 0 4;
Expand All @@ -57,19 +57,21 @@ let t_balance3 () =

let t_balance4() =
let d = 3 in
let z = Loc ((out 0 16,["key_93", out 0 43;
"key_90", out 0 56;
"key_87", out 0 69;
"key_102", out 0 68]),
["key_96",out 0 30]) in
let z = (out 0 16,
["key_93", out 0 43;
"key_90", out 0 56;
"key_87", out 0 69;
"key_102", out 0 68],
["key_96",out 0 30]) in
let z' = Indexz.balance d z in
assert_balanced z'

let t_balance5() =
let d = 3 in
let z = Loc
((out 0 74, [("key_63", out 0 271);
("key_109", out 0 270)]),
let z =
(out 0 74,
[("key_63", out 0 271);
("key_109", out 0 270)],
[("key_72", out 0 222);
("key_81", out 0 173);
("key_90", out 0 124)]) in
Expand Down

0 comments on commit 89dd04a

Please sign in to comment.