[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