c

39 files changed, 128 insertions, 0 deletions

diff --git a/algorithms/algorithms_lib.ml b/algorithms/algorithms_lib.ml
index 7eab223..400f3f7 100644
--- a/algorithms/algorithms_lib.ml
+++ b/algorithms/algorithms_lib.ml
@@ -1 +1,2 @@
 module Simulated_annealing = Simulated_annealing
+module Pbil = Pbil
diff --git a/app/pbil_benchmark/bin/dune b/app/pbil_benchmark/bin/dune
new file mode 100644
index 0000000..153859b
--- /dev/null
+++ b/app/pbil_benchmark/bin/dune
@@ -0,0 +1,12 @@
+(executable
+ (public_name pbil_benchmark)
+ (name pbil_benchmark)
+ (libraries
+  core
+  core_unix.command_unix
+  algorithms_lib
+  genetics_lib
+  pbil_benchmark_lib
+  utils_lib)
+ (preprocess
+  (pps ppx_jane)))
diff --git a/app/pbil_benchmark/bin/pbil_benchmark.ml b/app/pbil_benchmark/bin/pbil_benchmark.ml
new file mode 100644
index 0000000..adee8a6
--- /dev/null
+++ b/app/pbil_benchmark/bin/pbil_benchmark.ml
@@ -0,0 +1,3 @@
+open! Core
+
+let () = Command_unix.run Pbil_benchmark_lib.Main.command
diff --git a/app/pbil_benchmark/src/dune b/app/pbil_benchmark/src/dune
new file mode 100644
index 0000000..cf989ac
--- /dev/null
+++ b/app/pbil_benchmark/src/dune
@@ -0,0 +1,6 @@
+(library
+ (inline_tests)
+ (name pbil_benchmark_lib)
+ (libraries core owl owl-plplot curl utils_lib structures_lib algorithms_lib)
+ (preprocess
+  (pps ppx_inline_test ppx_jane)))
diff --git a/app/pbil_benchmark/src/evaluators.ml b/app/pbil_benchmark/src/evaluators.ml
new file mode 100644
index 0000000..4c39e25
--- /dev/null
+++ b/app/pbil_benchmark/src/evaluators.ml
@@ -0,0 +1,49 @@
+open! Core
+open Genetics_lib
+
+let one_max individual = Individual.gene individual |> Gene.fold ~init:0. ~f:Float.( + )
+
+let deceptive_one_max individual =
+  let result = one_max individual in
+  if Float.(result = 0.) then Individual.length individual + 1 |> Float.of_int else result
+;;
+
+let k_deceptive_one_max k individual =
+  Gene.foldi (Individual.gene individual) ~init:(0., 0) ~f:(fun i (sum, zero_cnt) value ->
+    let zero_cnt = if Float.(value = 0.) then zero_cnt + 1 else zero_cnt in
+    let sum =
+      if i % k = k - 1 && zero_cnt = k then sum +. Float.of_int (k + 1) else sum +. value
+    in
+    let zero_cnt = if i % k = k - 1 then 0 else zero_cnt in
+    sum, zero_cnt)
+  |> Tuple2.get1
+;;
+
+let%expect_test "evaluators" =
+  let individuals =
+    [ [ 1; 1; 1; 1; 1; 1 ]; [ 0; 0; 0; 0; 0; 0 ]; [ 0; 0; 1; 1; 0; 0 ] ]
+    |> List.map ~f:(List.map ~f:Float.of_int)
+    |> List.map ~f:Array.of_list
+    |> List.map ~f:Gene.create
+    |> List.map ~f:Individual.create
+  in
+  let evaluators =
+    [ "one_max", one_max
+    ; "deceptive_one_max", deceptive_one_max
+    ; "2_deceptive_one_max", k_deceptive_one_max 2
+    ]
+  in
+  List.iter individuals ~f:(fun individual ->
+    List.iter evaluators ~f:(fun (name, evaluator) ->
+      print_s [%message name (individual : Individual.t) (evaluator individual : float)]));
+  [%expect{|
+    (one_max (individual (1 1 1 1 1 1)) ("evaluator individual" 6))
+    (deceptive_one_max (individual (1 1 1 1 1 1)) ("evaluator individual" 6))
+    (2_deceptive_one_max (individual (1 1 1 1 1 1)) ("evaluator individual" 6))
+    (one_max (individual (0 0 0 0 0 0)) ("evaluator individual" 0))
+    (deceptive_one_max (individual (0 0 0 0 0 0)) ("evaluator individual" 7))
+    (2_deceptive_one_max (individual (0 0 0 0 0 0)) ("evaluator individual" 9))
+    (one_max (individual (0 0 1 1 0 0)) ("evaluator individual" 2))
+    (deceptive_one_max (individual (0 0 1 1 0 0)) ("evaluator individual" 2))
+    (2_deceptive_one_max (individual (0 0 1 1 0 0)) ("evaluator individual" 8)) |}]
+;;
diff --git a/app/pbil_benchmark/src/evaluators.mli b/app/pbil_benchmark/src/evaluators.mli
new file mode 100644
index 0000000..4889e9a
--- /dev/null
+++ b/app/pbil_benchmark/src/evaluators.mli
@@ -0,0 +1,6 @@
+open! Core
+open Genetics_lib
+
+val one_max : Individual.t -> float
+val deceptive_one_max : Individual.t -> float
+val k_deceptive_one_max : int -> Individual.t -> float
diff --git a/app/pbil_benchmark/src/main.ml b/app/pbil_benchmark/src/main.ml
new file mode 100644
index 0000000..d6053d9
--- /dev/null
+++ b/app/pbil_benchmark/src/main.ml
@@ -0,0 +1,45 @@
+open! Core
+open Algorithms_lib
+open Utils_lib
+
+let create_command evaluator =
+  Command.basic_or_error
+    ~summary:"one_max evaluation"
+    (let%map_open.Command () = Utils_lib.Log.set_level_via_param ()
+     and n = flag "n" (required int) ~doc:"INT PBIL instance size"
+     and trials = flag "trials" (required int) ~doc:"INT number of trials"
+     and population_size =
+       flag "population-size" (required int) ~doc:"INT population size"
+     and learning_coef =
+       flag "learning-coef" (required float) ~doc:"FLOAT learning coefficient"
+     and mutation_p = flag "mutation-p" (required float) ~doc:"FLOAT mutation probability"
+     and mutation_disturbance_coef =
+       flag
+         "mutation-disturbance-coef"
+         (required float)
+         ~doc:"FLOAT mutation disturbance coefficient"
+     in
+     fun () ->
+       let output =
+         Pbil.pbil
+           { Pbil.Input.gene_length = n
+           ; population_size
+           ; learning_coef
+           ; mutation_p
+           ; mutation_disturbance_coef
+           ; evaluate = evaluator
+           ; termination_condition = (fun _ ~iteration -> iteration >= trials)
+           }
+       in
+       Log.info_s [%sexp (output : Pbil.Output.t)];
+       Ok ())
+;;
+
+let command =
+  Command.group
+    ~summary:"Various benchmarking evaluators for PBIL algorithm"
+    [ "one-max", create_command Evaluators.one_max
+    ; "deceptive-one-max", create_command Evaluators.deceptive_one_max
+    ; "5-deceptive-one-max", create_command (Evaluators.k_deceptive_one_max 5)
+    ]
+;;
diff --git a/qap/src/main.mli b/app/pbil_benchmark/src/main.mli
index 780124b..780124b 100644
--- a/qap/src/main.mli
+++ b/app/pbil_benchmark/src/main.mli
diff --git a/qap/src/qap_lib.ml b/app/pbil_benchmark/src/pbil_benchmark_lib.ml
index a5a59ad..a5a59ad 100644
--- a/qap/src/qap_lib.ml
+++ b/app/pbil_benchmark/src/pbil_benchmark_lib.ml
diff --git a/qap/bin/dune b/app/qap/bin/dune
index 0710a9e..0710a9e 100644
--- a/qap/bin/dune
+++ b/app/qap/bin/dune
diff --git a/qap/bin/qap.ml b/app/qap/bin/qap.ml
index 1e0dfde..1e0dfde 100644
--- a/qap/bin/qap.ml
+++ b/app/qap/bin/qap.ml
diff --git a/qap/src/dune b/app/qap/src/dune
index 5be99d0..5be99d0 100644
--- a/qap/src/dune
+++ b/app/qap/src/dune
diff --git a/qap/src/main.ml b/app/qap/src/main.ml
index dfda915..dfda915 100644
--- a/qap/src/main.ml
+++ b/app/qap/src/main.ml
diff --git a/app/qap/src/main.mli b/app/qap/src/main.mli
new file mode 100644
index 0000000..780124b
--- /dev/null
+++ b/app/qap/src/main.mli
@@ -0,0 +1,3 @@
+open! Core
+
+val command : Command.t
diff --git a/qap/src/qap.ml b/app/qap/src/qap.ml
index c52288d..c52288d 100644
--- a/qap/src/qap.ml
+++ b/app/qap/src/qap.ml
diff --git a/qap/src/qap.mli b/app/qap/src/qap.mli
index 5422256..5422256 100644
--- a/qap/src/qap.mli
+++ b/app/qap/src/qap.mli
diff --git a/app/qap/src/qap_lib.ml b/app/qap/src/qap_lib.ml
new file mode 100644
index 0000000..a5a59ad
--- /dev/null
+++ b/app/qap/src/qap_lib.ml
@@ -0,0 +1 @@
+module Main = Main
diff --git a/common/genetics/dune b/lib/genetics/dune
index 7edec9c..7edec9c 100644
--- a/common/genetics/dune
+++ b/lib/genetics/dune
diff --git a/common/genetics/gene.ml b/lib/genetics/gene.ml
index fdba45e..d940e69 100644
--- a/common/genetics/gene.ml
+++ b/lib/genetics/gene.ml
@@ -7,6 +7,7 @@ let create = Fn.id
 let of_list = Array.of_list
 let length = Array.length
 let fold = Array.fold
+let foldi = Array.foldi
 let init length ~value = Array.init length ~f:(fun _ -> value)
 let random length = Array.init length ~f:(fun _ -> Stats.uniform_rvs ~a:0. ~b:1.)
 let iteri = Array.iteri
diff --git a/common/genetics/gene.mli b/lib/genetics/gene.mli
index e26c310..70ea69e 100644
--- a/common/genetics/gene.mli
+++ b/lib/genetics/gene.mli
@@ -6,6 +6,7 @@ val create : float array -> t
 val of_list : float list -> t
 val length : t -> int
 val fold : t -> init:'a -> f:('a -> float -> 'a) -> 'a
+val foldi : t -> init:'a -> f:(int -> 'a -> float -> 'a) -> 'a
 val init : int -> value:float -> t
 val iteri : t -> f:(int -> float -> unit) -> unit
 
diff --git a/common/genetics/genetics_lib.ml b/lib/genetics/genetics_lib.ml
index 4e3f80b..4e3f80b 100644
--- a/common/genetics/genetics_lib.ml
+++ b/lib/genetics/genetics_lib.ml
diff --git a/common/genetics/individual.ml b/lib/genetics/individual.ml
index bf08647..bf08647 100644
--- a/common/genetics/individual.ml
+++ b/lib/genetics/individual.ml
diff --git a/common/genetics/individual.mli b/lib/genetics/individual.mli
index ba4ac1c..ba4ac1c 100644
--- a/common/genetics/individual.mli
+++ b/lib/genetics/individual.mli
diff --git a/common/genetics/population.ml b/lib/genetics/population.ml
index 76017ca..76017ca 100644
--- a/common/genetics/population.ml
+++ b/lib/genetics/population.ml
diff --git a/common/genetics/population.mli b/lib/genetics/population.mli
index 950984a..950984a 100644
--- a/common/genetics/population.mli
+++ b/lib/genetics/population.mli
diff --git a/common/structures/dune b/lib/structures/dune
index a2327d2..a2327d2 100644
--- a/common/structures/dune
+++ b/lib/structures/dune
diff --git a/common/structures/permutation.ml b/lib/structures/permutation.ml
index d74ae33..d74ae33 100644
--- a/common/structures/permutation.ml
+++ b/lib/structures/permutation.ml
diff --git a/common/structures/permutation.mli b/lib/structures/permutation.mli
index b076d9f..b076d9f 100644
--- a/common/structures/permutation.mli
+++ b/lib/structures/permutation.mli
diff --git a/common/structures/structures_lib.ml b/lib/structures/structures_lib.ml
index 78b26d9..78b26d9 100644
--- a/common/structures/structures_lib.ml
+++ b/lib/structures/structures_lib.ml
diff --git a/common/utils/curl_helper.ml b/lib/utils/curl_helper.ml
index 730eaf8..730eaf8 100644
--- a/common/utils/curl_helper.ml
+++ b/lib/utils/curl_helper.ml
diff --git a/common/utils/curl_helper.mli b/lib/utils/curl_helper.mli
index 6ed67f1..6ed67f1 100644
--- a/common/utils/curl_helper.mli
+++ b/lib/utils/curl_helper.mli
diff --git a/common/utils/dune b/lib/utils/dune
index e43b627..e43b627 100644
--- a/common/utils/dune
+++ b/lib/utils/dune
diff --git a/common/utils/log.ml b/lib/utils/log.ml
index 2992378..2992378 100644
--- a/common/utils/log.ml
+++ b/lib/utils/log.ml
diff --git a/common/utils/log.mli b/lib/utils/log.mli
index 50230bf..50230bf 100644
--- a/common/utils/log.mli
+++ b/lib/utils/log.mli
diff --git a/common/utils/plotting.ml b/lib/utils/plotting.ml
index d4a8af3..d4a8af3 100644
--- a/common/utils/plotting.ml
+++ b/lib/utils/plotting.ml
diff --git a/common/utils/plotting.mli b/lib/utils/plotting.mli
index 8af5afa..8af5afa 100644
--- a/common/utils/plotting.mli
+++ b/lib/utils/plotting.mli
diff --git a/common/utils/random.ml b/lib/utils/random.ml
index b3fd05f..b3fd05f 100644
--- a/common/utils/random.ml
+++ b/lib/utils/random.ml
diff --git a/common/utils/random.mli b/lib/utils/random.mli
index 7eb339c..7eb339c 100644
--- a/common/utils/random.mli
+++ b/lib/utils/random.mli
diff --git a/common/utils/utils_lib.ml b/lib/utils/utils_lib.ml
index 536bf64..536bf64 100644
--- a/common/utils/utils_lib.ml
+++ b/lib/utils/utils_lib.ml