random generators in several modules, and CCRandom to bind them all with fuel

_oasis

@@ -41,7 +41,8 @@ Library "containers"
   Modules:          CCVector, CCDeque, CCGen, CCSequence, CCFQueue, CCMultiMap,
                     CCMultiSet, CCBV, CCPrint, CCPersistentHashtbl, CCError,
                     CCLeftistheap, CCList, CCOpt, CCPair, CCFun, CCHash,
-                    CCKList, CCInt, CCBool, CCArray, CCBatch, CCOrd, CCLinq
+                    CCKList, CCInt, CCBool, CCArray, CCBatch, CCOrd,
+                    CCRandom, CCLinq
   FindlibName:      containers
 
 Library "containers_string"

core/CCArray.ml

@@ -30,6 +30,7 @@ type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
 type 'a gen = unit -> 'a option
 type 'a equal = 'a -> 'a -> bool
 type 'a ord = 'a -> 'a -> int
+type 'a random_gen = Random.State.t -> 'a
 
 module type S = sig
   type 'a t
@@ -81,6 +82,10 @@ module type S = sig
   val shuffle_with : Random.State.t -> 'a t -> unit
   (** Like shuffle but using a specialized random state *)
 
+  val random_choose : 'a t -> 'a random_gen
+  (** Choose an element randomly.
+      @raise Not_found if the array/slice is empty *)
+
   val to_seq : 'a t -> 'a sequence
   val to_gen : 'a t -> 'a gen
   val to_klist : 'a t -> 'a klist
@@ -161,6 +166,10 @@ let _shuffle _rand_int a i j =
     a.(l) <- tmp;
   done
 
+let _choose a i j st =
+  if i>=j then raise Not_found;
+  a.(i+Random.int (j-i))
+
 let _pp ~sep pp_item buf a i j =
   for k = i to j - 1 do
     if k > i then Buffer.add_string buf sep;
@@ -321,6 +330,19 @@ let shuffle a = _shuffle Random.int a 0 (Array.length a)
 
 let shuffle_with st a = _shuffle (Random.State.int st) a 0 (Array.length a)
 
+let random_choose a st = _choose a 0 (Array.length a) st
+
+let random_len n g st =
+  Array.init n (fun _ -> g st)
+
+let random g st =
+  let n = Random.State.int st 1_000 in
+  random_len n g st
+
+let random_non_empty g st =
+  let n = 1 + Random.State.int st 1_000 in
+  random_len n g st
+
 let pp ?(sep=", ") pp_item buf a = _pp ~sep pp_item buf a 0 (Array.length a)
 
 let pp_i ?(sep=", ") pp_item buf a = _pp_i ~sep pp_item buf a 0 (Array.length a)
@@ -412,6 +434,8 @@ module Sub = struct
   let shuffle_with st a =
     _shuffle (Random.State.int st) a.arr a.i a.j
 
+  let random_choose a st = _choose a.arr a.i a.j st
+
   let pp ?(sep=", ") pp_item buf a = _pp ~sep pp_item buf a.arr a.i a.j
 
   let pp_i ?(sep=", ") pp_item buf a = _pp_i ~sep pp_item buf a.arr a.i a.j

core/CCArray.mli

@@ -30,6 +30,7 @@ type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
 type 'a gen = unit -> 'a option
 type 'a equal = 'a -> 'a -> bool
 type 'a ord = 'a -> 'a -> int
+type 'a random_gen = Random.State.t -> 'a
 
 (** {2 Abstract Signature} *)
 
@@ -83,6 +84,10 @@ module type S = sig
   val shuffle_with : Random.State.t -> 'a t -> unit
   (** Like shuffle but using a specialized random state *)
 
+  val random_choose : 'a t -> 'a random_gen
+  (** Choose an element randomly.
+      @raise Not_found if the array/slice is empty *)
+
   val to_seq : 'a t -> 'a sequence
   val to_gen : 'a t -> 'a gen
   val to_klist : 'a t -> 'a klist
@@ -129,6 +134,10 @@ val except_idx : 'a t -> int -> 'a list
 val (--) : int -> int -> int t
 (** Range array *)
 
+val random : 'a random_gen -> 'a t random_gen
+val random_non_empty : 'a random_gen -> 'a t random_gen
+val random_len : int -> 'a random_gen -> 'a t random_gen
+
 (** {2 Slices}
 A slice is a part of an array, that requires no copying and shares
 its storage with the original array.
@@ -155,7 +164,7 @@ module Sub : sig
 
   val underlying : 'a t -> 'a array
   (** Underlying array (shared). Modifying this array will modify the slice *)
-  
+
   val copy : 'a t -> 'a array
   (** Copy into a new array *)
 

core/CCHash.mli

@@ -26,7 +26,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 (** {1 Hash combinators}
 
 Combination of hashes based on the Murmur Hash (64 bits). See
-{{:https://sites.google.com/site/murmurhash/MurmurHash2_64.cpp?attredirects=0} this page}
+{{: https://sites.google.com/site/murmurhash/MurmurHash2_64.cpp?attredirects=0} this page}
 *)
 
 (** {2 Definitions} *)

core/CCInt.ml

@@ -39,6 +39,11 @@ let sign i =
 
 type 'a printer = Buffer.t -> 'a -> unit
 type 'a formatter = Format.formatter -> 'a -> unit
+type 'a random_gen = Random.State.t -> 'a
+
+let random n st = Random.State.int st n
+let random_small = random 100
+let random_range i j st = i + random (j-i) st
 
 let pp buf = Printf.bprintf buf "%d"
 let print fmt = Format.fprintf fmt "%d"

core/CCInt.mli

@@ -39,6 +39,11 @@ val sign : t -> int
 
 type 'a printer = Buffer.t -> 'a -> unit
 type 'a formatter = Format.formatter -> 'a -> unit
+type 'a random_gen = Random.State.t -> 'a
+
+val random : int -> t random_gen
+val random_small : t random_gen
+val random_range : int -> int -> t random_gen
 
 val pp : t printer
 val print : t formatter

core/CCList.ml

@@ -378,11 +378,22 @@ let range i j =
   range 5 2 = [5;4;3;2]
 *)
 
+let range' i j =
+  if i<j then range i (j-1)
+  else if i=j then []
+  else range i (j+1)
+
+(*$T
+  range' 0 0 = []
+  range' 0 5 = [0;1;2;3;4]
+  range' 5 2 = [5;4;3]
+*)
+
 let (--) = range
 
 (*$T
   append (range 0 100) (range 101 1000) = range 0 1000
-  append (range 1000 500) (range 499 0) = range 1000 0
+  append (range 1000 501) (range 500 0) = range 1000 0
 *)
 
 let replicate i x =
@@ -474,7 +485,7 @@ module Zipper = struct
         | None -> l,r
         | Some x' -> l, x::r
         end
-        
+
   let focused = function
     | _, x::_ -> Some x
     | _, [] -> None
@@ -491,6 +502,30 @@ type 'a gen = unit -> 'a option
 type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
 type 'a printer = Buffer.t -> 'a -> unit
 type 'a formatter = Format.formatter -> 'a -> unit
+type 'a random_gen = Random.State.t -> 'a
+
+let random_len len g st =
+  map (fun _ -> g st) (range' 0 len)
+
+(*$T
+  random_len 10 CCInt.random_small (Random.State.make [||]) |> List.length = 10
+*)
+
+let random g st =
+  let len = Random.State.int st 1_000 in
+  random_len len g st
+
+let random_non_empty g st =
+  let len = 1 + Random.State.int st 1_000 in
+  random_len len g st
+
+let random_choose l = match l with
+  | [] -> raise Not_found
+  | _::_ ->
+      let len = List.length l in
+      fun st ->
+        let i = Random.State.int st len in
+        List.nth l i
 
 let to_seq l k = List.iter k l
 let of_seq seq =

core/CCList.mli

@@ -152,9 +152,13 @@ end
 (** {2 Other Constructors} *)
 
 val range : int -> int -> int t
-(** [range i j] iterates on integers from [i] to [j] included. It works
+(** [range i j] iterates on integers from [i] to [j] included . It works
     both for decreasing and increasing ranges *)
 
+val range' : int -> int -> int t
+(** Same as {!range} but the second bound is excluded.
+    For instance [range' 0 5 = [0;1;2;3;4]] *)
+
 val (--) : int -> int -> int t
 (** Infix alias for [range] *)
 
@@ -223,6 +227,15 @@ type 'a gen = unit -> 'a option
 type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
 type 'a printer = Buffer.t -> 'a -> unit
 type 'a formatter = Format.formatter -> 'a -> unit
+type 'a random_gen = Random.State.t -> 'a
+
+val random : 'a random_gen -> 'a list random_gen
+val random_non_empty : 'a random_gen -> 'a list random_gen
+val random_len : int -> 'a random_gen -> 'a list random_gen
+
+val random_choose : 'a list -> 'a random_gen
+(** Randomly choose an element in the list.
+    @raise Not_found if the list is empty *)
 
 val to_seq : 'a t -> 'a sequence
 val of_seq : 'a sequence -> 'a t

core/CCOpt.ml

@@ -95,6 +95,10 @@ let of_list = function
 type 'a sequence = ('a -> unit) -> unit
 type 'a gen = unit -> 'a option
 type 'a printer = Buffer.t -> 'a -> unit
+type 'a random_gen = Random.State.t -> 'a
+
+let random g st =
+  if Random.State.bool st then Some (g st) else None
 
 let to_gen o =
   match o with

core/CCOpt.mli

@@ -74,6 +74,9 @@ val of_list : 'a list -> 'a t
 type 'a sequence = ('a -> unit) -> unit
 type 'a gen = unit -> 'a option
 type 'a printer = Buffer.t -> 'a -> unit
+type 'a random_gen = Random.State.t -> 'a
+
+val random : 'a random_gen -> 'a t random_gen
 
 val to_gen : 'a t -> 'a gen
 val to_seq : 'a t -> 'a sequence

core/CCRandom.ml

@@ -0,0 +1,152 @@
+
+(*
+copyright (c) 2013-2014, 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.
+*)
+
+(** {1 Random Generators} *)
+
+type state = Random.State.t
+
+type 'a t = state -> 'a
+type 'a random_gen = 'a t
+
+let return x _st = x
+
+let flat_map f g st = f (g st) st
+
+let (>>=) g f st = flat_map f g st
+
+let map f g st = f (g st)
+
+let (>|=) g f st = map f g st
+
+let choose_array a st =
+  if Array.length a = 0 then invalid_arg "CCRandom.choose_array";
+  a.(Random.State.int st (Array.length a)) st
+
+let choose l = choose_array (Array.of_list l)
+
+let choose_return l = choose_array (Array.of_list (List.map return l))
+
+(** {2 Fuel and Backtracking} *)
+
+module Fuel = struct
+  type fuel = int
+
+  exception Backtrack
+
+  (* consume [d] units of fuel and return [x] if it works *)
+  let _consume d fuel x =
+    if fuel >= d then Some (fuel-d,x) else None
+
+  let _split i st =
+    if i < 2 then raise Backtrack
+    else
+      let j = 1 + Random.State.int st (i-1) in
+      (j, i-j)
+
+  let split i st = try Some (_split i st) with Backtrack -> None
+
+  (* partition of an int into [len] integers. We divide-and-conquer on
+    the expected length, until it reaches 1. *)
+  let split_list i ~len st =
+    let rec aux i ~len acc =
+      if i < len then raise Backtrack
+      else if len = 1 then i::acc
+      else
+        (* split somewhere in the middle *)
+        let len1, len2 = _split len st in
+        if i = len
+        then aux len1 ~len:len1 (aux len2 ~len:len2 acc)
+        else
+          let i1, i2 = _split (i-len1-len2) st in
+          aux i1 ~len:len1 (aux i2 ~len:len2 acc)
+    in
+    try Some (aux i ~len []) with Backtrack -> None
+
+  (** {6 Fueled Generators} *)
+
+  type 'a t = fuel -> state -> (fuel * 'a) option
+
+  let return x fuel _st = _consume 1 fuel x
+
+  let return' fuel x fuel' _st = _consume fuel fuel' x
+
+  let flat_map f g fuel st =
+    match g fuel st with
+      | None -> None
+      | Some (fuel, x) -> f x fuel st
+
+  let (>>=) g f = flat_map f g
+
+  let map f g fuel st =
+    match g fuel st with
+    | None -> None
+    | Some (fuel, x) -> Some (fuel, f x)
+
+  let (>|=) g f = map f g
+
+  let consume fuel _st = _consume 1 fuel ()
+
+  let consume' fuel fuel' _st = _consume fuel fuel' ()
+
+  let fail _fuel _st = None
+
+  let retry ?(max=10) g fuel st =
+    let rec aux n =
+      match g fuel st with
+      | None when n=0 -> None
+      | None -> aux (n-1)  (* retry *)
+      | Some _ as res -> res
+    in
+    aux max
+
+  let rec try_successively l fuel st = match l with
+    | [] -> None
+    | g :: l' ->
+        begin match g fuel st with
+        | None -> try_successively l' fuel st
+        | Some _ as res -> res
+        end
+
+  let (<?>) a b = try_successively [a;b]
+
+  let rec fix f fuel st = f (fix f) fuel st
+
+  let lift g fuel st = _consume 1 fuel (g st)
+
+  let lift' d g fuel st = _consume d fuel (g st)
+
+  let run ?(fuel=fun st -> Random.State.int st 40) f st =
+    match f (fuel st) st with
+    | None -> None
+    | Some (_fuel, x) -> Some x
+
+  exception GenFailure
+
+  let run_exn ?fuel f st =
+    match run ?fuel f st with
+    | None -> raise GenFailure
+    | Some x -> x
+end

core/CCRandom.mli

@@ -0,0 +1,142 @@
+
+(*
+copyright (c) 2013-2014, 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.
+*)
+
+(** {1 Random Generators} *)
+
+type state = Random.State.t
+
+type 'a t = state -> 'a
+(** Random generator for values of type ['a] *)
+
+type 'a random_gen = 'a t
+
+val return : 'a -> 'a t
+(** [return x] is the generator that always returns [x].
+    Example:  [let random_int = return 4 (* fair dice roll *)] *)
+
+val flat_map : ('a -> 'b t) -> 'a t -> 'b t
+
+val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+
+val map : ('a -> 'b) -> 'a t -> 'b t
+
+val (>|=) : 'a t -> ('a -> 'b) -> 'b t
+
+val choose : 'a t list -> 'a t
+(** Choose a generator within the list.
+    @raise Invalid_argument if the list is empty *)
+
+val choose_array : 'a t array -> 'a t
+
+val choose_return : 'a list -> 'a t
+(** Choose among the list
+    @raise Invalid_argument if the list is empty *)
+
+(** {2 Fuel and Backtracking} *)
+
+module Fuel : sig
+  type fuel = int
+  (** The fuel is a value that represents some "resource" used by the
+      random generator. *)
+
+  val split : fuel -> (fuel * fuel) option t
+  (** Split a (fuel) value [n] into [n1,n2] where [n = n1 + n2].
+      @return [None] if the value is too small *)
+
+  val split_list : fuel -> len:int -> fuel list option t
+  (** Split a (fuel) value [n] into a list of values whose sum is [n]
+      and whose length is [length].
+      @return [None] if the value is too small *)
+
+  (** {6 Fueled Generators} *)
+
+  type 'a t = fuel -> state -> (fuel * 'a) option
+  (** Fueled generators use some fuel to generate a value.
+      Can fail by lack of fuel. *)
+
+  val return : 'a -> 'a t
+  (** [return x] is the generator that always returns [x], and consumes one
+      fuel doing it. *)
+
+  val return' : fuel -> 'a -> 'a t
+  (** [return' f x] returns [x] but also consumes [fuel]. *)
+
+  val flat_map : ('a -> 'b t) -> 'a t -> 'b t
+
+  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+
+  val map : ('a -> 'b) -> 'a t -> 'b t
+
+  val (>|=) : 'a t -> ('a -> 'b) -> 'b t
+
+  val consume : unit t
+  (** Consume one fuel value *)
+
+  val consume' : fuel -> unit t
+  (** Consume the given amount of fuel *)
+
+  val fail : 'a t
+  (** Always fails. *)
+
+  val retry : ?max:int -> 'a t -> 'a t
+  (** [retry g] calls [g] until it returns some value, or until the maximum
+      number of retries was reached. If [g] fails,
+      then it counts for one iteration, and the generator retries.
+      @param max: maximum number of retries. Default [10] *)
+
+  val try_successively : 'a t list -> 'a t
+  (** [try_successively l] tries each generator of [l], one after the other.
+      If some generator succeeds its result is returned, else the
+      next generator is tried *)
+
+  val (<?>) : 'a t -> 'a t -> 'a t
+  (** [a <?> b] is a choice operator. It first tries [a], and returns its
+      result if successful. If [a] fails, then [b] is returned. *)
+
+  val fix : ('a t -> 'a t) -> 'a t
+  (** Recursion combinators, for building (fueled) recursive values *)
+
+  val lift : 'a random_gen -> 'a t
+  (** lifts a regular random generator into a fueled one, that consumes
+      one fuel unit *)
+
+  val lift' : fuel -> 'a random_gen -> 'a t
+  (** lifts a regular random generator into a fueled one, that consumes
+      one fuel unit *)
+
+  (** {6 Running} *)
+
+  val run : ?fuel:fuel random_gen -> 'a t -> 'a option random_gen
+  (** Run the given fueled generator with an amount of fuel
+      given by the [fuel] generator.
+      @return None if the *)
+
+  exception GenFailure
+
+  val run_exn : ?fuel:fuel random_gen -> 'a t -> 'a random_gen
+  (** Same as {!run}, but in case of failure it raises an exception.
+      @raise GenFailure in case the generator fails *)
+end