Merge pull request #384 from moazzammoriani/fannkuchredux

Add new version of fannkuchredux and a multicore version

benchmarks/benchmarksgame/dune

@@ -1,8 +1,16 @@
-(executables (names binarytrees5 fannkuchredux fannkuchredux2 fasta3 fasta6
+(executables (names binarytrees5 fasta3 fasta6
                     knucleotide knucleotide3 mandelbrot6 nbody pidigits5
                     regexredux2 revcomp2 spectralnorm2)
-                    (modes native byte)
-              (libraries unix str zarith))
+             (modules binarytrees5 fasta3 fasta6
+                      knucleotide knucleotide3 mandelbrot6 nbody pidigits5
+                      regexredux2 revcomp2 spectralnorm2) 
+             (modes native byte)
+             (libraries unix str zarith))
+
+(executable (name fannkuchredux)
+            (modules fannkuchredux) 
+            (modes native byte)
+            (ocamlopt_flags -noassert -unsafe))
 
 (rule
      (targets input25000000.txt)
@@ -15,13 +23,13 @@
      (action (with-stdout-to %{targets} (run %{prog} 5_000_000 > %{targets}))))
 
 (alias (name buildbench)
-       (deps binarytrees5.exe fannkuchredux.exe fannkuchredux2.exe fasta3.exe
-             fasta6.exe knucleotide.exe knucleotide3.exe mandelbrot6.exe
+       (deps binarytrees5.exe fasta3.exe
+             fasta6.exe fannkuchredux.exe knucleotide.exe knucleotide3.exe mandelbrot6.exe
              nbody.exe pidigits5.exe regexredux2.exe revcomp2.exe
              spectralnorm2.exe input25000000.txt input5000000.txt))
 
 (alias (name bytebench)
-       (deps binarytrees5.bc fannkuchredux.bc fannkuchredux2.bc fasta3.bc
+       (deps binarytrees5.bc fannkuchredux.bc fasta3.bc
              fasta6.bc knucleotide.bc knucleotide3.bc mandelbrot6.bc
              nbody.bc pidigits5.bc regexredux2.bc revcomp2.bc
              spectralnorm2.bc input25000000.txt input5000000.txt))

benchmarks/benchmarksgame/fannkuchredux.ml

@@ -1,66 +1,125 @@
-(* The Computer Language Benchmarks Game
-   https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
+(*
+ * The Computer Language Benchmarks Game
+ * https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
+ *
+ * Contributed by Paolo Ribeca, August 2011
+ *
+ * (Based on the Java version by Oleg Mazurov)
+ *)
 
-   from Scala version by Otto Bommer, August 2010
-*)
+let n = try int_of_string Sys.argv.(1) with _ -> 7
 
-let fannkuch n =
-   begin
-   let perm1 = Array.make n 0 in for i = 0 to (n-1) do perm1.(i) <- i done;
-   let perm = Array.make n 0 in
-   let count = Array.make n 0 in
-   let flips = ref 0 
-   and maxflips = ref 0 
-   and checksum = ref 0 
-   and nperm = ref 0
-   and r = ref n in
-   while !r > 0 do 
-(*      Printf.printf "perm="; i := 0; while !i < n do Printf.printf "%d " perm1.(!i); i := !i +1; done; Printf.printf "\n"; *)
-      for i = 0 to n-1 do perm.(i) <- perm1.(i) done;
+let workers = 32
 
-      while !r != 1 do count.(!r-1) <- !r; r := !r - 1; done;
-
-      flips := 0;
-      let k = ref perm.(0) in
-      while !k != 0 do
-         let t = ref 0 in
-         for i = 0 to !k / 2 do
-            t := perm.(i);
-            perm.(i) <- perm.(!k - i);
-            perm.(!k - i) <- !t;
-            done;
-
-         k := perm.(0);
-         flips := !flips + 1;
-         done;
-
-      maxflips := max !maxflips !flips;
-      checksum := !checksum + !flips * (1 - (!nperm land 1) lsl 1);
-
-      let go = ref true in
-      let t = ref 0 in
-      while !go do
-         if !r == n then begin go := false; r := 0; end
-         else
-            begin
-            t := perm1.(0);
-            for i = 0 to !r - 1 do perm1.(i) <- perm1.(i+1) done;
-            perm1.(!r) <- !t;
-
-            count.(!r) <- count.(!r) - 1;
-            if count.(!r) > 0 then go := false
-            else r := !r + 1;
-            end
-         done;
-
-      nperm := !nperm + 1;
+module Perm =
+  struct
+    type t = { p: int array;
+               pp: int array;
+               c: int array }
+  let facts =
+    let n = 20 in
+    let res = Array.make (n + 1) 1 in
+    for i = 1 to n do
+      res.(i) <- i * res.(i - 1)
+    done;
+    res
+  (* Setting up the permutation based on the given index *)
+  let setup n idx =
+    let res = { p = Array.init n (fun i -> i);
+                pp = Array.make n 1;
+                c = Array.make n 1 }
+    and idx = ref idx in
+    for i = n - 1 downto 0 do
+      let d = !idx / facts.(i) in
+      res.c.(i) <- d;
+      idx := !idx mod facts.(i);
+      Array.blit res.p 0 res.pp 0 (i + 1);
+      for j = 0 to i do
+        res.p.(j) <- if j + d <= i then res.pp.(j + d) else res.pp.(j + d - i - 1)
+      done
+    done;
+    res
+  (* Getting the next permutation *)
+  let next { p = p; c = c; _ } =
+    let plen = Array.length p in
+    let f = ref p.(1) in
+    p.(1) <- p.(0);
+    p.(0) <- !f;
+    let i = ref 1 in
+    let aug_c = ref (c.(!i) + 1) in 
+    c.(!i) <- !aug_c;
+    while !aug_c > !i do
+      c.(!i) <- 0;
+      incr i;
+      let n = p.(1) in
+      p.(0) <- n;
+      let red_i = !i - 1 in
+      for j = 1 to red_i do
+        if plen > j+1 then begin p.(j) <- p.(j + 1); end else ()
       done;
+      if plen > !i then begin 
+        p.(!i) <- !f; 
+        f := n; 
+      end else ();
+      aug_c := c.(!i) + 1;
+      c.(!i) <- !aug_c
+    done
+  (* Counting the number of flips *)
+  let count { p = p ; pp = pp; _ } =
+    let f = ref p.(0) and res = ref 1 in
+    if p.(!f) <> 0 then begin
+      let len = Array.length p in
+      let red_len = len - 1 in
+      for i = 0 to red_len do pp.(i) <- p.(i) done;
+      while pp.(!f) <> 0 do
+        incr res;
+        let lo = ref 1 and hi = ref (!f - 1) in
+        while !lo < !hi do
+          let t = pp.(!lo) in
+          pp.(!lo) <- pp.(!hi);
+          pp.(!hi) <- t;
+          incr lo;
+          decr hi
+        done;
+        let ff = !f in
+        let t = pp.(ff) in
+        pp.(ff) <- ff;
+        f := t
+      done
+    end;
+    !res
+  end
 
-   (!maxflips, !checksum);
-   end
+let fr n lo hi = 
+    let p = Perm.setup n lo
+    and c = ref 0 and m = ref 0
+    and red_hi = hi - 1 in
+    for i = lo to red_hi do let r = Perm.count p in
+      c := !c + r * (1 - (i land 1) lsl 1);
+      if r > !m then
+      m := r;
+      Perm.next p
+    done;
+    (!c, !m)
 
-let _ =
-        let n = try int_of_string(Sys.argv.(1)) with _ -> 7 in
-        let (maxflips, checksum) = fannkuch n in
-        Printf.printf "%d\nPfannkuchen(%d) = %d\n" checksum n maxflips
+let main s_n =
+    let n = s_n in
+    let chunk_size = Perm.facts.(n) / workers
+    and rem = Perm.facts.(n) mod workers in
+    let w = ref (Array.init workers (fun _ -> (0, 0))) in
+    for i = 0 to (workers-1) do
+      Printf.printf "%d" i;
+      let lo = i * chunk_size + min i rem in
+      let hi = lo + chunk_size + if i < rem then 1 else 0 in
+      !w.(i) <- fr s_n lo hi
+    done;
+    let c = ref 0 and m = ref 0 in
+    Array.iter
+      (fun (nc, nm) ->
+        c := !c + nc;
+        m := max !m nm)
+      !w;
+    Printf.printf "%d\nPfannkuchen(%d) = %d\n" !c n !m
 
+let _ =
+  main n;

benchmarks/multicore-numerical/dune

@@ -113,9 +113,15 @@
  (modules evolutionary_algorithm_multicore)
  (libraries domainslib))
 
+(executable
+ (name fannkuchredux_multicore)
+ (modules fannkuchredux_multicore)
+ (libraries domainslib)
+ (ocamlopt_flags -noassert -unsafe))
+
 (alias
   (name multibench_parallel)
-  (deps mandelbrot6_multicore.exe spectralnorm2_multicore.exe quicksort.exe
+  (deps fannkuchredux_multicore.exe mandelbrot6_multicore.exe spectralnorm2_multicore.exe quicksort.exe
         quicksort_multicore.exe binarytrees5_multicore.exe
 	game_of_life.exe game_of_life_multicore.exe
 	matrix_multiplication.exe matrix_multiplication_multicore.exe