From e7075ca060a7947b30b51feaaa328d71ab93ab4b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 24 Sep 2013 15:03:33 +0200 Subject: [PATCH] imperative bitvector module --- BV.ml | 179 +++++++++++++++++++++++++++++++++++++++++++++ BV.mli | 93 +++++++++++++++++++++++ containers.mllib | 1 + tests/run_tests.ml | 1 + tests/test_bv.ml | 73 ++++++++++++++++++ 5 files changed, 347 insertions(+) create mode 100644 BV.ml create mode 100644 BV.mli create mode 100644 tests/test_bv.ml diff --git a/BV.ml b/BV.ml new file mode 100644 index 00000000..bc502291 --- /dev/null +++ b/BV.ml @@ -0,0 +1,179 @@ + +(* +copyright (c) 2013, simon cruanes +all rights reserved. + +redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. redistributions in binary +form must reproduce the above copyright notice, this list of conditions and the +following disclaimer in the documentation and/or other materials provided with +the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(** {2 Imperative Bitvectors} *) + +let __width = Sys.word_size - 2 + +(* int with [n] ones *) +let rec __shift bv n = + if n = 0 + then bv + else __shift ((bv lsl 1) lor 1) (n-1) + +(* only ones *) +let __all_ones = __shift 0 __width + +type t = int array + +let create ~size default = + if size = 0 then [| 0 |] + else begin + let n = if size mod __width = 0 then size / __width else (size / __width) + 1 in + let arr = if default + then Array.make n __all_ones + else Array.make n 0 + in + (* adjust last bits *) + if default && (size mod __width) <> 0 + then arr.(n-1) <- __shift 0 (size - (n-1) * __width); + arr + end + +let copy = Array.copy + +let length bv = Array.length bv + +let resize bv ~size default = + failwith "not implemented" + +(* count the 1 bits in [n]. See https://en.wikipedia.org/wiki/Hamming_weight *) +let __count_bits n = + let rec recurse count n = + if n = 0 then count else recurse (count+1) (n land (n-1)) + in + if n < 0 + then recurse 1 (n lsr 1) (* only on unsigned *) + else recurse 0 n + +let cardinal bv = + let n = ref 0 in + for i = 0 to Array.length bv - 1 do + n := !n + __count_bits bv.(i) + done; + !n + +let is_empty bv = + try + for i = 0 to Array.length bv - 1 do + if bv.(i) <> 0 then raise Exit + done; + true + with Exit -> + false + +let get bv i = + let n = i / __width in + let i = i - n * __width in + bv.(n) land (1 lsl i) <> 0 + +let set bv i = + let n = i / __width in + let i = i - n * __width in + bv.(n) <- bv.(n) lor (1 lsl i) + +let reset bv i = + let n = i / __width in + let i = i - n * __width in + bv.(n) <- bv.(n) land (lnot (1 lsl i)) + +let flip bv i = + let n = i / __width in + let i = i - n * __width in + bv.(n) <- bv.(n) lxor (1 lsl i) + +let clear bv = + Array.iteri (fun i _ -> bv.(i) <- 0) bv + +let iter bv f = + for n = 0 to Array.length bv - 1 do + let j = __width * n in + for i = 0 to __width - 1 do + f (j+i) (bv.(n) land (1 lsl i) <> 0) + done + done + +let iter_true bv f = + for n = 0 to Array.length bv - 1 do + let j = __width * n in + for i = 0 to __width - 1 do + if bv.(n) land (1 lsl i) <> 0 + then f (j+i) + done + done + +let to_list bv = + let l = ref [] in + iter_true bv (fun i -> l := i :: !l); + !l + +let of_list l = + let size = List.fold_left max 0 l in + let bv = create ~size false in + List.iter (fun i -> set bv i) l; + bv + +let union_into ~into bv = + assert (length into >= length bv); + for i = 0 to Array.length bv - 1 do + into.(i) <- into.(i) lor bv.(i) + done + +let union bv1 bv2 = + let size = __width * (max (Array.length bv1) (Array.length bv2)) in + let bv = create ~size false in + union_into ~into:bv bv1; + union_into ~into:bv bv2; + bv + +let inter_into ~into bv = + let n = min (length into) (length bv) in + for i = 0 to n - 1 do + into.(i) <- into.(i) land bv.(i) + done + +let inter bv1 bv2 = + if length bv1 < length bv2 + then + let bv = copy bv1 in + let () = inter_into ~into:bv bv2 in + bv + else + let bv = copy bv2 in + let () = inter_into ~into:bv bv1 in + bv + +let select bv arr = + let l = ref [] in + begin try + iter_true bv + (fun i -> + if i >= Array.length arr + then raise Exit + else l := (arr.(i), i) :: !l) + with Exit -> () + end; + !l diff --git a/BV.mli b/BV.mli new file mode 100644 index 00000000..a3584af2 --- /dev/null +++ b/BV.mli @@ -0,0 +1,93 @@ + +(* +copyright (c) 2013, simon cruanes +all rights reserved. + +redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. redistributions in binary +form must reproduce the above copyright notice, this list of conditions and the +following disclaimer in the documentation and/or other materials provided with +the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(** {2 Imperative Bitvectors} *) + +type t + +val create : size:int -> bool -> t + (** Create a bitvector of given size, with given default value *) + +val copy : t -> t + (** Copy of bitvector *) + +val resize : t -> size:int -> bool -> t + (** [resize bv ~size default] resizes [bv] to the given size. If the + new size is bigger than the old one, new values are set to [default]. *) + +val cardinal : t -> int + (** Number of bits set *) + +val length : t -> int + (** Length of underlying array *) + +val is_empty : t -> bool + (** Any bit set? *) + +val set : t -> int -> unit + (** Set i-th bit *) + +val get : t -> int -> bool + (** Is the i-th bit true? *) + +val reset : t -> int -> unit + (** Set i-th bit to 0 *) + +val flip : t -> int -> unit + (** Flip i-th bit *) + +val clear : t -> unit + (** Set every bit to 0 *) + +val iter : t -> (int -> bool -> unit) -> unit + (** Iterate on all bits *) + +val iter_true : t -> (int -> unit) -> unit + (** Iterate on bits set to 1 *) + +val to_list : t -> int list + (** List of indexes that are true *) + +val of_list : int list -> t + (** From a list of true bits *) + +val union_into : into:t -> t -> unit + (** [union ~into bv] sets [into] to the union of itself and [bv]. + [into] must have at least as long as [bv]. *) + +val inter_into : into:t -> t -> unit + (** [union ~into bv] sets [into] to the intersection of itself and [bv] *) + +val union : t -> t -> t + (** [union bv1 bv2] returns the union of the two sets *) + +val inter : t -> t -> t + +val select : t -> 'a array -> ('a * int) list + (** [select arr bv] selects the elements of [arr] whose index + correspond to a true bit in [bv]. The elements are paired to their + index in [arr]. If [bv] is too short, elements of [arr] with too high + an index cannot be returned. *) diff --git a/containers.mllib b/containers.mllib index 3c6be110..fcf0bb3c 100644 --- a/containers.mllib +++ b/containers.mllib @@ -29,3 +29,4 @@ AbsSet CSM MultiMap ActionMan +BV diff --git a/tests/run_tests.ml b/tests/run_tests.ml index f30d3940..a9c70d40 100644 --- a/tests/run_tests.ml +++ b/tests/run_tests.ml @@ -7,6 +7,7 @@ let suite = [ Test_pHashtbl.suite; Test_PersistentHashtbl.suite; Test_bencode.suite; + Test_bv.suite; Test_Behavior.suite; Test_PiCalculus.suite; Test_splayMap.suite; diff --git a/tests/test_bv.ml b/tests/test_bv.ml new file mode 100644 index 00000000..b12cd84a --- /dev/null +++ b/tests/test_bv.ml @@ -0,0 +1,73 @@ +open OUnit + +let test_cardinal () = + let bv1 = BV.create ~size:87 true in + assert_equal ~printer:string_of_int 87 (BV.cardinal bv1); + () + +let test_get () = + let bv = BV.create ~size:99 false in + assert_bool "32 must be false" (not (BV.get bv 32)); + assert_bool "88 must be false" (not (BV.get bv 88)); + assert_bool "5 must be false" (not (BV.get bv 5)); + BV.set bv 32; + BV.set bv 88; + BV.set bv 5; + assert_bool "32 must be true" (BV.get bv 32); + assert_bool "88 must be true" (BV.get bv 88); + assert_bool "5 must be true" (BV.get bv 5); + assert_bool "33 must be false" (not (BV.get bv 33)); + assert_bool "44 must be false" (not (BV.get bv 44)); + assert_bool "1 must be false" (not (BV.get bv 1)); + () + +let test_list () = + let bv = BV.of_list [1; 5; 156; 0; 222] in + assert_equal ~printer:string_of_int 5 (BV.cardinal bv); + BV.set bv 201; + assert_equal ~printer:string_of_int 6 (BV.cardinal bv); + let l = BV.to_list bv in + let l = List.sort compare l in + assert_equal [0;1;5;156;201;222] l; + () + +let test_clear () = + let bv = BV.of_list [1; 5; 200] in + assert_equal ~printer:string_of_int 3 (BV.cardinal bv); + BV.clear bv; + assert_equal ~printer:string_of_int 0 (BV.cardinal bv); + assert_bool "must be empty" (BV.is_empty bv); + () + +let test_union () = + let bv1 = BV.of_list [1;2;3;4] in + let bv2 = BV.of_list [4;200;3] in + let bv = BV.union bv1 bv2 in + let l = List.sort compare (BV.to_list bv) in + assert_equal [1;2;3;4;200] l; + () + +let test_inter () = + let bv1 = BV.of_list [1;2;3;4] in + let bv2 = BV.of_list [4;200;3] in + BV.inter_into ~into:bv1 bv2; + let l = List.sort compare (BV.to_list bv1) in + assert_equal [3;4] l; + () + +let test_select () = + let bv = BV.of_list [1;2;5;400] in + let arr = [|"a"; "b"; "c"; "d"; "e"; "f"|] in + let l = List.sort compare (BV.select bv arr) in + assert_equal [("b",1); ("c",2); ("f",5)] l; + () + +let suite = "test_bv" >::: + [ "test_cardinal" >:: test_cardinal + ; "test_get" >:: test_get + ; "test_list" >:: test_list + ; "test_clear" >:: test_clear + ; "test_union" >:: test_union + ; "test_inter" >:: test_inter + ; "test_select" >:: test_select + ]