From d4271c5ef6125945b73f548bdccc4e88cf8c1559 Mon Sep 17 00:00:00 2001 From: th3rac25 Date: Sat, 21 Jul 2018 13:45:52 +1200 Subject: [PATCH 1/2] fix depth-preserving left subtree insertion --- avl.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/avl.ml b/avl.ml index f004f61..2edab4d 100644 --- a/avl.ml +++ b/avl.ml @@ -98,7 +98,7 @@ module RawAVLTree = struct | Same -> Deeper (Tree (t', tv, r, More)) | Less -> PSameDepth (Tree (t', tv, r, Same)) end - | PSameDepth t' -> PSameDepth (Tree (t', v, r, diff)) + | PSameDepth t' -> PSameDepth (Tree (t', tv, r, diff)) end | Equal -> PSameDepth t | GreaterThan -> begin From 590351aa4f3bc0704619ed9623a1ad5a9e07d231 Mon Sep 17 00:00:00 2001 From: th3rac25 Date: Mon, 23 Jul 2018 15:21:31 +1200 Subject: [PATCH 2/2] fix remove_min_elt for trees with only one element --- avl.ml | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/avl.ml b/avl.ml index 2edab4d..20653d2 100644 --- a/avl.ml +++ b/avl.ml @@ -119,6 +119,7 @@ module RawAVLTree = struct let rec remove_min_elt : type d. ('a, d s) atree -> ('a, d s) neg_result = function | Tree (Empty, _, r, Less) -> Shallower r + | Tree (Empty, _, r, Same) -> Shallower r | Tree (l, tv, r, Less) -> begin match l with | Empty -> raise Empty_tree @@ -145,14 +146,11 @@ module RawAVLTree = struct | NSameDepth t -> NSameDepth (Tree (t, tv, r, More)) | Shallower t -> Shallower (Tree (t, tv, r, Same)) end - | Tree (l, tv, r, Same) -> begin - match l with - | Empty -> raise Empty_tree - | Tree _ as l -> - let result = remove_min_elt l in - match result with - | NSameDepth t -> NSameDepth (Tree (t, tv, r, Same)) - | Shallower t -> NSameDepth (Tree (t, tv, r, Less)) + | Tree (Tree(_) as l, tv, r, Same) -> begin + let result = remove_min_elt l in + match result with + | NSameDepth t -> NSameDepth (Tree (t, tv, r, Same)) + | Shallower t -> NSameDepth (Tree (t, tv, r, Less)) end let merge : type m n o. ('a, m) atree -> ('a, n) atree -> (m, n, o) diff -> ('a, o) pos_result =