Array.partition benchmarks (see #829)

[gasche]

cc: @UnixJunkie

Please try the benchmarks on your machine:

cd benchsuite
ocamlbuild -package batteries -use-ocamlfind array_partition.native --

On my machine, they confirm that your implementation in #829 is faster. I would support merging both pull-requests.

[UnixJunkie]

I updated the Array.partition code to include some of your optimizations over my implementation in gasche_partition.
Should we include this as is, for history, or should this PR be updated?

[UnixJunkie]

Having provided a benchmark is nice, however I don't like so much large chunks of code lying around.

[UnixJunkie]

You can reopen if you super strongly disagree, though.

[gasche]

(Personally I think that having benchmarks around is useful in case people want to work on optimizing the functions again, but you do as you prefer.)

[UnixJunkie]

You have a point.

[UnixJunkie]

If you know how the merge conflict should be resolved, I vote to merge it.

PS: I hope those benchs are not always run when we compile batteries, I guess not

[fccm]

Hi,
I tried to use type bytes instead of type bool array for the mask:

$ cat partition-for-cider.patch
diff --git a/src/batArray.mliv b/src/batArray.mliv
index b58d6704..be2d7ce7 100644
--- a/src/batArray.mliv
+++ b/src/batArray.mliv
@@ -512,6 +512,8 @@ val count_matching : ('a -> bool) -> 'a array -> int
 val find_all : ('a -> bool) -> 'a array -> 'a array
 (** [find_all] is another name for {!Array.filter}. *)
 
+val partition_orig : ('a -> bool) -> 'a array -> 'a array * 'a array
+val partition_b : ('a -> bool) -> 'a array -> 'a array * 'a array
 val partition : ('a -> bool) -> 'a array -> 'a array * 'a array
 (** [partition p a] returns a pair of arrays [(a1, a2)], where
     [a1] is the array of all the elements of [a] that
diff --git a/src/batArray.mlv b/src/batArray.mlv
index 9a9290cf..fa9f352e 100644
--- a/src/batArray.mlv
+++ b/src/batArray.mlv
@@ -292,6 +292,65 @@ let filteri p xs =
 
 let find_all = filter
 
+let partition_orig p xs =
+  let n = length xs in
+  (* Use a bitset to store which elements will be in which final array. *)
+  let bs = BatBitSet.create n in
+  for i = 0 to n-1 do
+    if p xs.(i) then BatBitSet.set bs i
+  done;
+  (* Allocate the final arrays and copy elements into them. *)
+  let n1 = BatBitSet.count bs in
+  let n2 = n - n1 in
+  let j = ref 0 in
+  let xs1 = init n1
+      (fun _ ->
+        (* Find the next set bit in the BitSet. *)
+        while not (BatBitSet.mem bs !j) do incr j done;
+        let r = xs.(!j) in
+        incr j;
+        r) in
+  let j = ref 0 in
+  let xs2 = init n2
+      (fun _ ->
+        (* Find the next clear bit in the BitSet. *)
+        while BatBitSet.mem bs !j do incr j done;
+        let r = xs.(!j) in
+        incr j;
+        r) in
+  (xs1, xs2)
+
+let partition_b p a =
+  let n = length a in
+  if n = 0 then ([||], [||])
+  else
+    let ok_count = ref 0 in
+    let _true = char_of_int 1 in
+    let _false = char_of_int 0 in
+    let mask =
+      Bytes.init n (fun i ->
+          let pi = p (unsafe_get a i) in
+          if pi
+          then (incr ok_count; _true)
+          else _false) in
+    let ko_count = n - !ok_count in
+    let init = unsafe_get a 0 in
+    let ok = make !ok_count init in
+    let ko = make ko_count init in
+    let j = ref 0 in
+    let k = ref 0 in
+    for i = 0 to n - 1 do
+      let x = unsafe_get a i in
+      let px = Bytes.unsafe_get mask i in
+      if px = _true then
+        (unsafe_set ok !j x;
+         incr j)
+      else
+        (unsafe_set ko !k x;
+         incr k)
+    done;
+    (ok, ko)
+
 (* <=> List.partition *)
 let partition p a =
   let n = length a in

$ time ./part.opt orig
len: 4194303

real    0m15,274s
user    0m14,663s
sys     0m0,608s

$ time ./part.opt uj
len: 4194303

real    0m13,391s
user    0m12,687s
sys     0m0,696s

$ time ./part.opt bytes
len: 4194303

real    0m9,646s
user    0m9,068s
sys     0m0,575s

[fccm]

@gasche's version can also be improved a little bit the same way using a type bytes or string instead of a type bool array:

let gasche_partition_s p xs =
  let n = BatArray.length xs in
  if n = 0 then ([||], [||]) else begin
    let size_yes = ref 0 in
    let _true = char_of_int 1 in
    let _false = char_of_int 0 in
    let bs = Bytes.init n (fun i ->
        let b = p (BatArray.unsafe_get xs i) in
        if b
        then (incr size_yes; _true)
        else _false) in
    let yes = Array.make !size_yes xs.(0) in
    let no = Array.make (n - !size_yes) xs.(0) in
    let iyes = ref 0 in
    let ino = ref 0 in
    for i = 0 to n - 1 do
      if (Bytes.unsafe_get bs i) = _true then begin
        BatArray.unsafe_set yes !iyes (BatArray.unsafe_get xs i);
        incr iyes;
      end else begin
        BatArray.unsafe_set no !ino (BatArray.unsafe_get xs i);
        incr ino;
      end
    done;
    yes, no
  end

pseudo-bench:

$ time ./part.opt gasche
len: 4194303

real    0m1,414s
user    0m1,280s
sys     0m0,133s

$ time ./part.opt gasche_s
len: 4194303

real    0m1,015s
user    0m0,950s
sys     0m0,065s

it will maybe also use less space.

[UnixJunkie]

@fccm the time command, while useful to have a first idea, is not proper benchmarking.
The good thing with bytes instead of bool is that we also get some significant memory saving at run-time, I suspect.

Cf. https://github.com/janestreet/core_bench/ or https://github.com/Chris00/ocaml-benchmark

[fccm]

I agree with you, this is why I wrote "pseudo-bench",
It's just that benchmarks seem currently broken, see issue #1003

[fccm]

I didn't notice any performances difference between bytes and string, so using string is probably a better choice to stay backward compatible.

[UnixJunkie]

Feeling I am living dangerously: I just resolved the conflicts using github's interface, on a PR which is not mine...