[m-rev.] for review: optimise tree_bitset.delete

Peter Wang novalazy at gmail.com
Fri Apr 20 11:56:31 AEST 2012


For review by Zoltan.

Branches: main

library/tree_bitset.m:
	Implement `tree_bitset.delete' directly instead of using the more
	general `difference' operation.

tests/hard_coded/test_tree_bitset.exp:
tests/hard_coded/test_tree_bitset.m:
	Extend test case to cover `delete'.

diff --git a/library/tree_bitset.m b/library/tree_bitset.m
index 51d4058..d1b3c62 100644
--- a/library/tree_bitset.m
+++ b/library/tree_bitset.m
@@ -1229,7 +1229,85 @@ interiorlist_insert_new(Index, Level, Nodes0 @ [Head0 | Tail0], Nodes) :-
 
 insert_list(Set, List) = union(list_to_set(List), Set).
 
-delete(Set, Elem) = difference(Set, insert(init, Elem)).
+%-----------------------------------------------------------------------------%
+
+delete(Set0, Elem) = Set :-
+    Set0 = tree_bitset(List0),
+    Index = enum_to_index(Elem),
+    (
+        List0 = leaf_list(LeafNodes0),
+        leaflist_delete(LeafNodes0, Index, LeafNodes),
+        List = leaf_list(LeafNodes)
+    ;
+        List0 = interior_list(Level, InteriorNodes0),
+        interiorlist_delete(InteriorNodes0, Index, InteriorNodes),
+        List1 = interior_list(Level, InteriorNodes),
+        prune_top_levels(List1, List)
+    ),
+    Set = wrap_tree_bitset(List).
+
+:- pred interiorlist_delete(list(interior_node)::in, int::in,
+    list(interior_node)::out) is det.
+
+interiorlist_delete([], _, []).
+interiorlist_delete([Head0 | Tail0], Index, Result) :-
+    ( Head0 ^ limit_offset =< Index ->
+        interiorlist_delete(Tail0, Index, Tail),
+        Result = [Head0 | Tail]
+    ; Head0 ^ init_offset =< Index ->
+        Components0 = Head0 ^ components,
+        (
+            Components0 = leaf_list(LeafNodes0),
+            leaflist_delete(LeafNodes0, Index, LeafNodes),
+            (
+                LeafNodes = [],
+                Result = Tail0
+            ;
+                LeafNodes = [_ | _],
+                Components = leaf_list(LeafNodes),
+                Head = interior_node(
+                    Head0 ^ init_offset, Head0 ^ limit_offset, Components),
+                Result = [Head | Tail0]
+            )
+        ;
+            Components0 = interior_list(Level, InteriorNodes0),
+            interiorlist_delete(InteriorNodes0, Index, InteriorNodes),
+            (
+                InteriorNodes = [],
+                Result = Tail0
+            ;
+                InteriorNodes = [_ | _],
+                Components = interior_list(Level, InteriorNodes),
+                Head = interior_node(
+                    Head0 ^ init_offset, Head0 ^ limit_offset, Components),
+                Result = [Head | Tail0]
+            )
+        )
+    ;
+        Result = [Head0 | Tail0]
+    ).
+
+:- pred leaflist_delete(list(leaf_node)::in, int::in, list(leaf_node)::out)
+    is det.
+
+leaflist_delete([], _, []).
+leaflist_delete([Head0 | Tail0], Index, Result) :-
+    Offset = Head0 ^ leaf_offset,
+    ( Offset + bits_per_int =< Index ->
+        leaflist_delete(Tail0, Index, Tail),
+        Result = [Head0 | Tail]
+    ; Offset =< Index ->
+        Bits = clear_bit(Head0 ^ leaf_bits, Index - Offset),
+        ( Bits \= 0 ->
+            Result = [make_leaf_node(Offset, Bits) | Tail0]
+        ;
+            Result = Tail0
+        )
+    ;
+        Result = [Head0 | Tail0]
+    ).
+
+%-----------------------------------------------------------------------------%
 
 delete_list(Set, List) = difference(Set, list_to_set(List)).
 
diff --git a/tests/hard_coded/test_tree_bitset.exp b/tests/hard_coded/test_tree_bitset.exp
index 78b3ade..05b628f 100644
--- a/tests/hard_coded/test_tree_bitset.exp
+++ b/tests/hard_coded/test_tree_bitset.exp
@@ -16,6 +16,8 @@ testing difference
 testing remove_least
 2
 [7, 15, 19, 22, 25, 28, 29, 31, 32, 34, 36, 38, 39, 40, 42, 44, 47, 58, 59]
+testing delete
+[7, 15, 19, 22, 25, 28, 29, 32, 34, 36, 47, 59]
 testing delete_list
 [7, 15, 19, 22, 25, 28, 29, 32, 34, 36, 47, 59]
 testing divide_by_set
@@ -39,6 +41,8 @@ testing difference
 testing remove_least
 532
 [32431]
+testing delete
+[532, 32431]
 testing delete_list
 [532, 32431]
 testing divide_by_set
@@ -62,6 +66,8 @@ testing difference
 testing remove_least
 1064
 [64862]
+testing delete
+[1064, 64862]
 testing delete_list
 [1064, 64862]
 testing divide_by_set
@@ -85,6 +91,8 @@ testing difference
 testing remove_least
 1
 [29424]
+testing delete
+[29424]
 testing delete_list
 [29424]
 testing divide_by_set
@@ -108,6 +116,8 @@ testing difference
 testing remove_least
 2
 [58848]
+testing delete
+[58848]
 testing delete_list
 [58848]
 testing divide_by_set
@@ -131,6 +141,8 @@ testing difference
 testing remove_least
 1
 []
+testing delete
+[1]
 testing delete_list
 [1]
 testing divide_by_set
@@ -154,6 +166,8 @@ testing difference
 testing remove_least
 2
 []
+testing delete
+[2]
 testing delete_list
 [2]
 testing divide_by_set
@@ -177,6 +191,8 @@ testing difference
 testing remove_least
 101
 [102]
+testing delete
+[101, 102]
 testing delete_list
 [101, 102]
 testing divide_by_set
@@ -200,6 +216,8 @@ testing difference
 testing remove_least
 202
 [204]
+testing delete
+[202, 204]
 testing delete_list
 [202, 204]
 testing divide_by_set
@@ -223,6 +241,8 @@ testing difference
 testing remove_least
 35702
 [35703, 35705, 36696]
+testing delete
+[35702, 35703, 35705, 36696]
 testing delete_list
 [35702, 35703, 35705, 36696]
 testing divide_by_set
@@ -246,6 +266,8 @@ testing difference
 testing remove_least
 71404
 [71406, 71410, 73392]
+testing delete
+[71404, 71406, 71410, 73392]
 testing delete_list
 [71404, 71406, 71410, 73392]
 testing divide_by_set
@@ -268,6 +290,8 @@ testing difference
 []
 testing remove_least
 call failed
+testing delete
+[]
 testing delete_list
 []
 testing divide_by_set
@@ -290,6 +314,8 @@ testing difference
 []
 testing remove_least
 call failed
+testing delete
+[]
 testing delete_list
 []
 testing divide_by_set
@@ -312,6 +338,8 @@ testing difference
 []
 testing remove_least
 call failed
+testing delete
+[]
 testing delete_list
 []
 testing divide_by_set
@@ -334,6 +362,8 @@ testing difference
 []
 testing remove_least
 call failed
+testing delete
+[]
 testing delete_list
 []
 testing divide_by_set
@@ -357,6 +387,8 @@ testing difference
 testing remove_least
 2
 []
+testing delete
+[2]
 testing delete_list
 [2]
 testing divide_by_set
@@ -380,6 +412,8 @@ testing difference
 testing remove_least
 4
 []
+testing delete
+[4]
 testing delete_list
 [4]
 testing divide_by_set
@@ -403,6 +437,8 @@ testing difference
 testing remove_least
 2
 [35701]
+testing delete
+[2, 35701]
 testing delete_list
 [2, 35701]
 testing divide_by_set
@@ -426,6 +462,8 @@ testing difference
 testing remove_least
 4
 [71402]
+testing delete
+[4, 71402]
 testing delete_list
 [4, 71402]
 testing divide_by_set
@@ -437,6 +475,7 @@ testing union
 testing intersection
 testing difference
 testing remove_least
+testing delete
 testing delete_list
 testing divide_by_set
 testing count
@@ -445,6 +484,7 @@ testing union
 testing intersection
 testing difference
 testing remove_least
+testing delete
 testing delete_list
 testing divide_by_set
 testing count
@@ -453,6 +493,7 @@ testing union
 testing intersection
 testing difference
 testing remove_least
+testing delete
 testing delete_list
 testing divide_by_set
 testing count
@@ -461,6 +502,7 @@ testing union
 testing intersection
 testing difference
 testing remove_least
+testing delete
 testing delete_list
 testing divide_by_set
 testing count
@@ -469,6 +511,7 @@ testing union
 testing intersection
 testing difference
 testing remove_least
+testing delete
 testing delete_list
 testing divide_by_set
 testing count
@@ -477,6 +520,7 @@ testing union
 testing intersection
 testing difference
 testing remove_least
+testing delete
 testing delete_list
 testing divide_by_set
 testing count
@@ -485,6 +529,7 @@ testing union
 testing intersection
 testing difference
 testing remove_least
+testing delete
 testing delete_list
 testing divide_by_set
 testing count
@@ -493,6 +538,7 @@ testing union
 testing intersection
 testing difference
 testing remove_least
+testing delete
 testing delete_list
 testing divide_by_set
 testing count
@@ -501,6 +547,7 @@ testing union
 testing intersection
 testing difference
 testing remove_least
+testing delete
 testing delete_list
 testing divide_by_set
 testing count
@@ -509,5 +556,6 @@ testing union
 testing intersection
 testing difference
 testing remove_least
+testing delete
 testing delete_list
 testing divide_by_set
diff --git a/tests/hard_coded/test_tree_bitset.m b/tests/hard_coded/test_tree_bitset.m
index 7dd82b4..1f26637 100644
--- a/tests/hard_coded/test_tree_bitset.m
+++ b/tests/hard_coded/test_tree_bitset.m
@@ -39,6 +39,7 @@
     ;       test_intersection
     ;       test_difference
     ;       test_remove_least
+    ;       test_delete
     ;       test_delete_list
     ;       test_divide_by_set
     ;       test_all.
@@ -294,17 +295,31 @@ do_run_test(Write, WhichTest, List1 - List2, !IO) :-
     ),
 
     (
+        ( WhichTest = test_delete
+        ; WhichTest = test_all
+        )
+    ->
+        io.write_string("testing delete\n", !IO),
+        list.foldl(test_bitset.delete, List2, Set1, Delete2From1),
+        maybe_write_bitset(Write, Delete2From1, !IO),
+
+        list.foldl(test_bitset.delete, List1, Set1, Delete1From1),
+        require(unify(Delete1From1, init), "Delete1From1 is not empty")
+    ;
+        true
+    ),
+
+    (
         ( WhichTest = test_delete_list
         ; WhichTest = test_all
         )
     ->
         io.write_string("testing delete_list\n", !IO),
-        test_bitset.delete_list(List2, Set1, Delete2From1),
-        maybe_write_bitset(Write, Delete2From1, !IO),
+        test_bitset.delete_list(List2, Set1, DeleteList2From1),
+        maybe_write_bitset(Write, DeleteList2From1, !IO),
 
-        test_bitset.delete_list(List1, Set1, Delete1From1),
-        test_bitset.init(Empty),
-        require(unify(Delete1From1, Empty), "Delete1From1 is not empty")
+        test_bitset.delete_list(List1, Set1, DeleteList1From1),
+        require(unify(DeleteList1From1, init), "DeleteList1From1 is not empty")
     ;
         true
     ),

--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list