Commits

bergsoe  committed e1399f8

Newline issues.

  • Participants
  • Parent commits 4013e9b

Comments (0)

Files changed (5)

File src/PaplConstraint.ml

   Copyright (c) 2012 Anders Lau Olsen.
   See LICENSE file for terms and conditions.
 *)
-
-type 'a t = 'a -> bool
-
-let accept f x = not (f x)
-
-let reject f x = f x
-
-let make_reject f = f
-
-let make_accept f = (); fun x -> not (f x)
-
-let (<&>) ca cb = (); fun x -> ca x || cb x
-
-let merge cs = (); fun x -> BatEnum.exists (fun c -> c x) cs
-
-let fixed_reject res = (); fun _ -> res
-
-let fixed_accept res = (); fun _ -> not res
-
-let invert constr = (); fun x -> not (constr x)
-
-let bind get cs = (); fun x -> cs (get x)
-
-let constrain_path c =
-  let reject = List.exists (reject c) in
-    make_reject reject
-
-(*
-  Other constraints:
-
-  - [novel metric minDist values] checks if a value is at least a distance
-    [minDist] away from all elements of [values].
-
-    A version of [novel] may collect the values it is given to produce an
-    increasingly stronger constraint.
-
-  - A constraint that counts the number of times it has been invoked.
-*)
+
+type 'a t = 'a -> bool
+
+let accept f x = not (f x)
+
+let reject f x = f x
+
+let make_reject f = f
+
+let make_accept f = (); fun x -> not (f x)
+
+let (<&>) ca cb = (); fun x -> ca x || cb x
+
+let merge cs = (); fun x -> BatEnum.exists (fun c -> c x) cs
+
+let fixed_reject res = (); fun _ -> res
+
+let fixed_accept res = (); fun _ -> not res
+
+let invert constr = (); fun x -> not (constr x)
+
+let bind get cs = (); fun x -> cs (get x)
+
+let constrain_path c =
+  let reject = List.exists (reject c) in
+    make_reject reject
+
+(*
+  Other constraints:
+
+  - [novel metric minDist values] checks if a value is at least a distance
+    [minDist] away from all elements of [values].
+
+    A version of [novel] may collect the values it is given to produce an
+    increasingly stronger constraint.
+
+  - A constraint that counts the number of times it has been invoked.
+*)

File src/PaplInterpolate.ml

   Copyright (c) 2012 Anders Lau Olsen.
   See LICENSE file for terms and conditions.
 *)
-
-type 'a t = 'a -> 'a -> float -> 'a
-
-type 'a intermediary_t = 'a -> 'a -> 'a BatEnum.t
-
-let stop () = raise BatEnum.No_more_elements
-
-let flip_interpolate ip s a b = ip a b s
-
-let intermediary_steps interpolate (metric, eps) a b =
-  let ip = interpolate a b in
-  let len = metric a b in
-  let step = eps /. len in
-  let pos = ref step in
-  let next () =
-    if !pos < 1.0 then
-      let q = ip !pos in
-        pos := !pos +. step;
-        q
-    else
-      stop ()
-  in
-    BatEnum.from next
-
-(* See also this alternative implementation that accepts a looser connection
-   between the metric and the interpolation.
-
-let intermediary_steps interpolate (metric, eps) start goal =
-  let pos = ref start in
-  let next () =
-    let d = metric !pos goal in
-      if d < eps then
-        stop ()
-      else
-        let pos' = interpolate (eps /. d) !pos goal in
-          pos := pos';
-          pos'
-  in
-    BatEnum.from next
-*)
-
-module Float = struct
-  let interpolate a b s = a +. (b -. a) *. s
-  let flip_interpolate s a b = interpolate a b s
-end
-
-module Int = struct
-  let round v = int_of_float (v +. 0.5)
-
-  let interpolate x y s =
-    round (Float.interpolate (float_of_int x) (float_of_int y) s)
-end
-
-module Tuple2 = struct
-  let interpolate ipa ipb (a0, b0) (a1, b1) =
-    let ip1 = ipa a0 a1 in
-    let ip2 = ipb b0 b1 in
-      fun s -> ip1 s, ip2 s
-end
-
-module Tuple3 = struct
-  let interpolate ipa ipb ipc (a0, b0, c0) (a1, b1, c1) =
-    let ip1 = ipa a0 a1 in
-    let ip2 = ipb b0 b1 in
-    let ip3 = ipc c0 c1 in
-      fun s -> ip1 s, ip2 s, ip3 s
-end
-
-module List = struct
-  let interpolate ip xs ys s =
-    List.map2 (flip_interpolate ip s) xs ys
-end
-
-module Array = struct
-  let interpolate ip xs ys s =
-    BatArray.map2 (flip_interpolate ip s) xs ys
-end
+
+type 'a t = 'a -> 'a -> float -> 'a
+
+type 'a intermediary_t = 'a -> 'a -> 'a BatEnum.t
+
+let stop () = raise BatEnum.No_more_elements
+
+let flip_interpolate ip s a b = ip a b s
+
+let intermediary_steps interpolate (metric, eps) a b =
+  let ip = interpolate a b in
+  let len = metric a b in
+  let step = eps /. len in
+  let pos = ref step in
+  let next () =
+    if !pos < 1.0 then
+      let q = ip !pos in
+        pos := !pos +. step;
+        q
+    else
+      stop ()
+  in
+    BatEnum.from next
+
+(* See also this alternative implementation that accepts a looser connection
+   between the metric and the interpolation.
+
+let intermediary_steps interpolate (metric, eps) start goal =
+  let pos = ref start in
+  let next () =
+    let d = metric !pos goal in
+      if d < eps then
+        stop ()
+      else
+        let pos' = interpolate (eps /. d) !pos goal in
+          pos := pos';
+          pos'
+  in
+    BatEnum.from next
+*)
+
+module Float = struct
+  let interpolate a b s = a +. (b -. a) *. s
+  let flip_interpolate s a b = interpolate a b s
+end
+
+module Int = struct
+  let round v = int_of_float (v +. 0.5)
+
+  let interpolate x y s =
+    round (Float.interpolate (float_of_int x) (float_of_int y) s)
+end
+
+module Tuple2 = struct
+  let interpolate ipa ipb (a0, b0) (a1, b1) =
+    let ip1 = ipa a0 a1 in
+    let ip2 = ipb b0 b1 in
+      fun s -> ip1 s, ip2 s
+end
+
+module Tuple3 = struct
+  let interpolate ipa ipb ipc (a0, b0, c0) (a1, b1, c1) =
+    let ip1 = ipa a0 a1 in
+    let ip2 = ipb b0 b1 in
+    let ip3 = ipc c0 c1 in
+      fun s -> ip1 s, ip2 s, ip3 s
+end
+
+module List = struct
+  let interpolate ip xs ys s =
+    List.map2 (flip_interpolate ip s) xs ys
+end
+
+module Array = struct
+  let interpolate ip xs ys s =
+    BatArray.map2 (flip_interpolate ip s) xs ys
+end

File src/PaplMetric.ml

   Copyright (c) 2012 Anders Lau Olsen.
   See LICENSE file for terms and conditions.
 *)
-
-type 'a pair_t = 'a * 'a
-
-type 'a t = 'a -> 'a -> float
-
-type 'a norm_t = 'a -> float
-
-type 'a option_t = 'a -> 'a -> float option
-
-type 'a norm_option_t = 'a -> float option
-
-type 'a threshold_t = 'a t * float
-
-let to_option m = (); fun a b -> Some (m a b)
-
-let to_option_less_than m eps = ();
-  fun a b ->
-    let d = m a b in
-      if d < eps then Some d
-      else None
-
-let bind f m a b = f (m a b)
-
-let scale s = bind (( *. ) s)
-
-let add m n a b = m a b +. n a b
-
-let pow m p = bind (fun v -> v**p) m
-
-let path_length m xs =
-  match xs with
-      [] -> invalid_arg "path_length: empty path."
-    | [_] -> invalid_arg "path_length: one-element path."
-    | x :: xs -> fst
-        (List.fold_left
-           (fun (len, prev) next -> (len +. m prev next, next))
-           (0., x)
-           xs)
-
-module Float = struct
-  let dist a b = abs_float (b -. a)
-end
-
-module Int = struct
-  let dist a b = float_of_int (abs (b - a))
-end
-
-module Tuple2 = struct
-  let dist_helper f g m0 m1 (a0, a1) (b0, b1) =
-    let d0 = m0 a0 b0 in
-    let d1 = m1 a1 b1 in
-      g (f d0) (f d1)
-
-  let id x = x
-
-  let dist1 m0 m1 = dist_helper id (+.) m0 m1
-
-  let sq x = x *. x
-  let dist2_sqr m0 m1 = dist_helper sq (+.) m0 m1
-
-  let dist2 m0 m1 = dist_helper sq (fun a b -> sqrt (a +. b)) m0 m1
-
-  let dist_inf m0 m1 = dist_helper id max m0 m1
-end
-
-module type OPTION = sig
-  type t
-  val dist : t option_t
-end
+
+type 'a pair_t = 'a * 'a
+
+type 'a t = 'a -> 'a -> float
+
+type 'a norm_t = 'a -> float
+
+type 'a option_t = 'a -> 'a -> float option
+
+type 'a norm_option_t = 'a -> float option
+
+type 'a threshold_t = 'a t * float
+
+let to_option m = (); fun a b -> Some (m a b)
+
+let to_option_less_than m eps = ();
+  fun a b ->
+    let d = m a b in
+      if d < eps then Some d
+      else None
+
+let bind f m a b = f (m a b)
+
+let scale s = bind (( *. ) s)
+
+let add m n a b = m a b +. n a b
+
+let pow m p = bind (fun v -> v**p) m
+
+let path_length m xs =
+  match xs with
+      [] -> invalid_arg "path_length: empty path."
+    | [_] -> invalid_arg "path_length: one-element path."
+    | x :: xs -> fst
+        (List.fold_left
+           (fun (len, prev) next -> (len +. m prev next, next))
+           (0., x)
+           xs)
+
+module Float = struct
+  let dist a b = abs_float (b -. a)
+end
+
+module Int = struct
+  let dist a b = float_of_int (abs (b - a))
+end
+
+module Tuple2 = struct
+  let dist_helper f g m0 m1 (a0, a1) (b0, b1) =
+    let d0 = m0 a0 b0 in
+    let d1 = m1 a1 b1 in
+      g (f d0) (f d1)
+
+  let id x = x
+
+  let dist1 m0 m1 = dist_helper id (+.) m0 m1
+
+  let sq x = x *. x
+  let dist2_sqr m0 m1 = dist_helper sq (+.) m0 m1
+
+  let dist2 m0 m1 = dist_helper sq (fun a b -> sqrt (a +. b)) m0 m1
+
+  let dist_inf m0 m1 = dist_helper id max m0 m1
+end
+
+module type OPTION = sig
+  type t
+  val dist : t option_t
+end

File src/PaplPlanner.ml

   Copyright (c) 2012 Anders Lau Olsen.
   See LICENSE file for terms and conditions.
 *)
-
-type 'a pair_t = 'a * 'a
-
-type 'a region_t = 'a list PaplSampler.t
-
-type 'a region_pair_t = 'a region_t pair_t
-
-exception Path_not_found of string
-
-type ('target, 'result) t = PaplStopCriteria.t -> 'target -> 'result
-
-type ('target, 'result) option_t = ('target, 'result option) t
-
-type ('target, 'q) path_t = ('target, 'q list) t
-
-type 'a point_t = ('a * 'a, 'a) path_t
-
-type 'a sampler_t = ('a region_pair_t, 'a) path_t
-
-type ('target, 'q) trajectory_t = ('target, 'q PaplTrajectory.t) t
-
-type 'q point_trajectory_t = ('q * 'q, 'q) trajectory_t
-
-type 'a sampler_trajectory_t = ('a region_pair_t, 'a) trajectory_t
-
-let fail msg = raise (Path_not_found msg)
-
-let to_option planner =
-  let planner stop target =
-    try Some (planner stop target)
-    with Path_not_found msg ->
-      Printf.printf "Planner message: %s\n" msg;
-      None
-  in
-    planner
-
-let bind_target f planner = ();
-  fun stop target -> planner stop (f target)
-
-let map_result f planner = ();
-  fun stop target -> f (planner stop target)
-
-let point_to_sampler_target target =
-  BatPair.map (fun q -> BatList.enum [[q]]) target
-
-let sampler_to_point_planner sampler_planner =
-  bind_target point_to_sampler_target sampler_planner
-
-let point_to_sampler_planner pp =
-  let rec get stop region =
-    if PaplStopCriteria.stop stop then
-      fail "Stop criteria said stop before region point was found"
-    else
-      match BatEnum.get region with
-          None -> fail "Region sampler is empty"
-        | Some [] -> get stop region
-        | Some (q :: _) -> q
-  in
-  let sp stop target =
-    pp stop (BatPair.map (get stop) target)
-  in
-    sp
-
-module Trajectory = struct
-  let of_metric ?t0 interpolate metric path_planner =
-    map_result
-      (fun path -> PaplTrajectory.of_path ?t0 interpolate metric path)
-      path_planner
-end
-
-module type BIDIR = sig
-  type q_t
-  type a_t
-  type b_t
-
-  val planner : (a_t * b_t, q_t) path_t
-end
-
-module type POINT_BIDIR = sig
-  type q_t
-  include BIDIR with type q_t := q_t
-                and type a_t = q_t
-                and type b_t = q_t
-end
-
-module type SAMPLER_BIDIR = sig
-  type q_t
-  include BIDIR with type q_t := q_t
-                and type a_t = q_t region_t
-                and type b_t = q_t region_t
-end
+
+type 'a pair_t = 'a * 'a
+
+type 'a region_t = 'a list PaplSampler.t
+
+type 'a region_pair_t = 'a region_t pair_t
+
+exception Path_not_found of string
+
+type ('target, 'result) t = PaplStopCriteria.t -> 'target -> 'result
+
+type ('target, 'result) option_t = ('target, 'result option) t
+
+type ('target, 'q) path_t = ('target, 'q list) t
+
+type 'a point_t = ('a * 'a, 'a) path_t
+
+type 'a sampler_t = ('a region_pair_t, 'a) path_t
+
+type ('target, 'q) trajectory_t = ('target, 'q PaplTrajectory.t) t
+
+type 'q point_trajectory_t = ('q * 'q, 'q) trajectory_t
+
+type 'a sampler_trajectory_t = ('a region_pair_t, 'a) trajectory_t
+
+let fail msg = raise (Path_not_found msg)
+
+let to_option planner =
+  let planner stop target =
+    try Some (planner stop target)
+    with Path_not_found msg ->
+      Printf.printf "Planner message: %s\n" msg;
+      None
+  in
+    planner
+
+let bind_target f planner = ();
+  fun stop target -> planner stop (f target)
+
+let map_result f planner = ();
+  fun stop target -> f (planner stop target)
+
+let point_to_sampler_target target =
+  BatPair.map (fun q -> BatList.enum [[q]]) target
+
+let sampler_to_point_planner sampler_planner =
+  bind_target point_to_sampler_target sampler_planner
+
+let point_to_sampler_planner pp =
+  let rec get stop region =
+    if PaplStopCriteria.stop stop then
+      fail "Stop criteria said stop before region point was found"
+    else
+      match BatEnum.get region with
+          None -> fail "Region sampler is empty"
+        | Some [] -> get stop region
+        | Some (q :: _) -> q
+  in
+  let sp stop target =
+    pp stop (BatPair.map (get stop) target)
+  in
+    sp
+
+module Trajectory = struct
+  let of_metric ?t0 interpolate metric path_planner =
+    map_result
+      (fun path -> PaplTrajectory.of_path ?t0 interpolate metric path)
+      path_planner
+end
+
+module type BIDIR = sig
+  type q_t
+  type a_t
+  type b_t
+
+  val planner : (a_t * b_t, q_t) path_t
+end
+
+module type POINT_BIDIR = sig
+  type q_t
+  include BIDIR with type q_t := q_t
+                and type a_t = q_t
+                and type b_t = q_t
+end
+
+module type SAMPLER_BIDIR = sig
+  type q_t
+  include BIDIR with type q_t := q_t
+                and type a_t = q_t region_t
+                and type b_t = q_t region_t
+end

File src/PaplSampler.ml

   Copyright (c) 2012 Anders Lau Olsen.
   See LICENSE file for terms and conditions.
 *)
-type rng_t = PaplRandom.rng_t
-
-type 'a pair_t = 'a * 'a
-
-open BatStd
-
-type 'a t = 'a BatEnum.t
-
-type range_t = float * float
-
-type int_range_t = int * int
-
-exception RangeError of string * (float * float)
-
-exception IntRangeError of string * (int * int)
-
-let stop () = raise BatEnum.No_more_elements
-
-let pi = BatFloat.pi
-
-let product2 sa sb = BatEnum.combine (sa, sb)
-
-let product3 sa sb sc =
-  let next () =
-    match BatEnum.get sa, BatEnum.get sb, BatEnum.get sc with
-        Some a, Some b, Some c -> (a, b, c)
-      | _ -> stop ()
-  in
-    BatEnum.from next
-
-let pair s = product2 s s
-
-let intersperse sx total sy =
-  let n = ref total in
-  let cnt = ref 0 in
-  let rec next () =
-    if !cnt == 0 then
-      match BatEnum.get sx with
-          None -> stop ()
-        | Some x ->
-            cnt := !n;
-            x
-    else begin
-      cnt := !cnt - 1;
-      match BatEnum.get sy with
-          None ->
-            n := 0;
-            cnt := 0;
-            next ()
-        | Some y ->
-            y
-    end
-  in BatEnum.from next
-
-let c = PaplConstraint.reject
-
-let rec constrain sampler constr =
-  BatEnum.filter (PaplConstraint.accept constr) sampler
-
-let rec constrain_with_default sampler constr default =
-  let rec next () =
-    match BatEnum.get sampler with
-        None -> stop ()
-      | Some x ->
-          if c constr x then
-            match BatEnum.get default with
-                None -> next ()
-              | Some y -> y
-          else
-            x
-  in BatEnum.from next
-
-let rec round_robin samplers =
-  let ss = ref samplers in
-  let acc = ref [] in
-  let rec next () =
-    match BatEnum.get !ss, !acc with
-        None, [] -> stop ()
-      | None, _ ->
-          ss := BatList.backwards !acc;
-          acc := [];
-          next ()
-      | Some s, _ ->
-          match BatEnum.get s with
-              None -> next ()
-            | Some x ->
-                acc := s :: !acc;
-                x
-  in BatEnum.from next
-
-(*
-  The values are inserted in a balanced binary tree with each node storing the
-  total weight of its values. The nodes are stored in an array as is usually
-  done for heaps.
-*)
-let distribute_by_weight_helper make_sampler pairs =
-  let tree = BatArray.of_enum pairs in
-  let left i = 2 * i + 1 in
-  let right i = 2 * i + 2 in
-  let get i = tree.(i) in
-  let valid i = i < Array.length tree in
-  let rec build i =
-    if valid i then begin
-      let wl = build (left i) in
-      let wr = build (right i) in
-      let (w, x) = get i in
-      let w' = w +. wl +. wr in
-        tree.(i) <- (w', x);
-        w'
-    end
-    else 0.0
-  in
-  let max = build 0 in
-  let position_sampler = make_sampler max in
-  let weight i = if valid i then fst (tree.(i)) else 0.0 in
-  let rec lookup i p =
-    let wl = weight (left i) in
-    if p < wl then
-      lookup (left i) p
-    else
-      let p' = p -. wl in
-      let wr = weight (right i) in
-        if p' < wr then
-          lookup (right i) p'
-        else
-          snd (get i) in
-  let make () =
-    match BatEnum.get position_sampler with
-        None -> stop ()
-      | Some p -> lookup 0 p
-  in
-    if Array.length tree == 0 then
-      invalid_arg "Empty enum of pairs given."
-    else
-      BatEnum.from make
-
-let distribute_by_weight ?rng pairs =
-  distribute_by_weight_helper (PaplRandom.enum_float ?rng) pairs
-
-let uniform_helper enum_fun (a, b) =
-  if a > b then BatEnum.empty ()
-  else BatEnum.map ((+.) a) (enum_fun (b -. a))
-
-let get_uniform_helper float_fun (a, b) =
-  if a > b then
-    raise (RangeError ("a > b", (a, b)))
-  else a +. float_fun (b -. a)
-
-let get_uniform ?rng range =
-  get_uniform_helper (PaplRandom.float ?rng) range
-
-let uniform ?rng range = uniform_helper (PaplRandom.enum_float ?rng) range
-
-let uniform_int_helper enum_fun (a, b) =
-  if a >= b then BatEnum.empty ()
-  else if a = b - 1 then BatEnum.repeat a
-  else BatEnum.map ((+) a) (enum_fun (b - a))
-
-let uniform_int ?rng range =
-  uniform_int_helper (PaplRandom.enum_int ?rng) range
-
-(* Given a function that returns pairs (x, y), construct a caching function that
-   returns first x and then y.
-*)
-let sequence_pairs pair_fun =
-  let result = ref None in
-  let next () =
-    match !result with
-      | None ->
-          let (x, y) = pair_fun () in
-            result := Some y;
-            x
-      | Some y ->
-          result := None;
-          y
-  in next
-
-(* Normally distributed numbers by the Box-Muller transform.
-
-   http://en.wikipedia.org/wiki/Box%E2%80%93Muller_transform
-
-   Boost Random uses this algorithm and so does Python's random module.
-*)
-let box_muller_gaussian float_fun =
-  let r () = float_fun 1.0 in (* Range [0, 1) *)
-  let pairs () =
-    let u1, u2 = r (), r () in
-    let rho = sqrt (-2. *. log (1. -. u1)) in
-    let a = 2. *. pi *. u2 in
-      (rho *. cos a, rho *. sin a)
-  in let next = sequence_pairs pairs in
-    BatEnum.from next
-
-let gaussian_helper = box_muller_gaussian
-
-let gaussian ?rng () =
-  gaussian_helper (PaplRandom.float ?rng)
-
-let mean_and_variance stream =
-  let xs = BatList.of_enum stream in
-  let n = List.length xs in
-    if n < 2 then
-      invalid_arg "stream is shorter than 2\n"
-    else
-      let n' = float_of_int n in
-      let sum = BatList.fsum xs in
-      let mean = sum /. n' in
-      let variance =
-        let sum_of_squares =
-          List.fold_right (fun x acc -> acc +. x *. x) xs 0.
-        in (sum_of_squares -. n' *. mean *. mean) /. (n' -. 1.)
-      in (mean, variance)
-
-(*
-
-We should add a bunch of useful sampler, perhaps here, perhaps in their own
-modules. Things we can sample:
-
-  - Configuration space boxes [done: see PaplQ].
-  - Rotation matrices
-  - Transformation matrices
-  - Sphere surfaces
-  - Sphere volumes
-  - Triangle surfaces
-  - Polygon surfaces
-  - Deterministic samplers for spheres, boxes, etc.
-
-Some of these things we should leave out or keep in their own modules. We want a
-compact and precise library, not something stuffed with every arbitrary
-math-like function that other people are also writing all the time. We want to
-show that we can integrate things. We don't want to provide all the things that
-can be integrated. Or at least not at this stage. It might be worthwhile to aim
-for a larger library if the library had a group of users.
-
-We really want to keep things separate. There should pretty much be zero
-concrete types anywhere in the core set of modules.
-
-*)
+type rng_t = PaplRandom.rng_t
+
+type 'a pair_t = 'a * 'a
+
+open BatStd
+
+type 'a t = 'a BatEnum.t
+
+type range_t = float * float
+
+type int_range_t = int * int
+
+exception RangeError of string * (float * float)
+
+exception IntRangeError of string * (int * int)
+
+let stop () = raise BatEnum.No_more_elements
+
+let pi = BatFloat.pi
+
+let product2 sa sb = BatEnum.combine (sa, sb)
+
+let product3 sa sb sc =
+  let next () =
+    match BatEnum.get sa, BatEnum.get sb, BatEnum.get sc with
+        Some a, Some b, Some c -> (a, b, c)
+      | _ -> stop ()
+  in
+    BatEnum.from next
+
+let pair s = product2 s s
+
+let intersperse sx total sy =
+  let n = ref total in
+  let cnt = ref 0 in
+  let rec next () =
+    if !cnt == 0 then
+      match BatEnum.get sx with
+          None -> stop ()
+        | Some x ->
+            cnt := !n;
+            x
+    else begin
+      cnt := !cnt - 1;
+      match BatEnum.get sy with
+          None ->
+            n := 0;
+            cnt := 0;
+            next ()
+        | Some y ->
+            y
+    end
+  in BatEnum.from next
+
+let c = PaplConstraint.reject
+
+let rec constrain sampler constr =
+  BatEnum.filter (PaplConstraint.accept constr) sampler
+
+let rec constrain_with_default sampler constr default =
+  let rec next () =
+    match BatEnum.get sampler with
+        None -> stop ()
+      | Some x ->
+          if c constr x then
+            match BatEnum.get default with
+                None -> next ()
+              | Some y -> y
+          else
+            x
+  in BatEnum.from next
+
+let rec round_robin samplers =
+  let ss = ref samplers in
+  let acc = ref [] in
+  let rec next () =
+    match BatEnum.get !ss, !acc with
+        None, [] -> stop ()
+      | None, _ ->
+          ss := BatList.backwards !acc;
+          acc := [];
+          next ()
+      | Some s, _ ->
+          match BatEnum.get s with
+              None -> next ()
+            | Some x ->
+                acc := s :: !acc;
+                x
+  in BatEnum.from next
+
+(*
+  The values are inserted in a balanced binary tree with each node storing the
+  total weight of its values. The nodes are stored in an array as is usually
+  done for heaps.
+*)
+let distribute_by_weight_helper make_sampler pairs =
+  let tree = BatArray.of_enum pairs in
+  let left i = 2 * i + 1 in
+  let right i = 2 * i + 2 in
+  let get i = tree.(i) in
+  let valid i = i < Array.length tree in
+  let rec build i =
+    if valid i then begin
+      let wl = build (left i) in
+      let wr = build (right i) in
+      let (w, x) = get i in
+      let w' = w +. wl +. wr in
+        tree.(i) <- (w', x);
+        w'
+    end
+    else 0.0
+  in
+  let max = build 0 in
+  let position_sampler = make_sampler max in
+  let weight i = if valid i then fst (tree.(i)) else 0.0 in
+  let rec lookup i p =
+    let wl = weight (left i) in
+    if p < wl then
+      lookup (left i) p
+    else
+      let p' = p -. wl in
+      let wr = weight (right i) in
+        if p' < wr then
+          lookup (right i) p'
+        else
+          snd (get i) in
+  let make () =
+    match BatEnum.get position_sampler with
+        None -> stop ()
+      | Some p -> lookup 0 p
+  in
+    if Array.length tree == 0 then
+      invalid_arg "Empty enum of pairs given."
+    else
+      BatEnum.from make
+
+let distribute_by_weight ?rng pairs =
+  distribute_by_weight_helper (PaplRandom.enum_float ?rng) pairs
+
+let uniform_helper enum_fun (a, b) =
+  if a > b then BatEnum.empty ()
+  else BatEnum.map ((+.) a) (enum_fun (b -. a))
+
+let get_uniform_helper float_fun (a, b) =
+  if a > b then
+    raise (RangeError ("a > b", (a, b)))
+  else a +. float_fun (b -. a)
+
+let get_uniform ?rng range =
+  get_uniform_helper (PaplRandom.float ?rng) range
+
+let uniform ?rng range = uniform_helper (PaplRandom.enum_float ?rng) range
+
+let uniform_int_helper enum_fun (a, b) =
+  if a >= b then BatEnum.empty ()
+  else if a = b - 1 then BatEnum.repeat a
+  else BatEnum.map ((+) a) (enum_fun (b - a))
+
+let uniform_int ?rng range =
+  uniform_int_helper (PaplRandom.enum_int ?rng) range
+
+(* Given a function that returns pairs (x, y), construct a caching function that
+   returns first x and then y.
+*)
+let sequence_pairs pair_fun =
+  let result = ref None in
+  let next () =
+    match !result with
+      | None ->
+          let (x, y) = pair_fun () in
+            result := Some y;
+            x
+      | Some y ->
+          result := None;
+          y
+  in next
+
+(* Normally distributed numbers by the Box-Muller transform.
+
+   http://en.wikipedia.org/wiki/Box%E2%80%93Muller_transform
+
+   Boost Random uses this algorithm and so does Python's random module.
+*)
+let box_muller_gaussian float_fun =
+  let r () = float_fun 1.0 in (* Range [0, 1) *)
+  let pairs () =
+    let u1, u2 = r (), r () in
+    let rho = sqrt (-2. *. log (1. -. u1)) in
+    let a = 2. *. pi *. u2 in
+      (rho *. cos a, rho *. sin a)
+  in let next = sequence_pairs pairs in
+    BatEnum.from next
+
+let gaussian_helper = box_muller_gaussian
+
+let gaussian ?rng () =
+  gaussian_helper (PaplRandom.float ?rng)
+
+let mean_and_variance stream =
+  let xs = BatList.of_enum stream in
+  let n = List.length xs in
+    if n < 2 then
+      invalid_arg "stream is shorter than 2\n"
+    else
+      let n' = float_of_int n in
+      let sum = BatList.fsum xs in
+      let mean = sum /. n' in
+      let variance =
+        let sum_of_squares =
+          List.fold_right (fun x acc -> acc +. x *. x) xs 0.
+        in (sum_of_squares -. n' *. mean *. mean) /. (n' -. 1.)
+      in (mean, variance)
+
+(*
+
+We should add a bunch of useful sampler, perhaps here, perhaps in their own
+modules. Things we can sample:
+
+  - Configuration space boxes [done: see PaplQ].
+  - Rotation matrices
+  - Transformation matrices
+  - Sphere surfaces
+  - Sphere volumes
+  - Triangle surfaces
+  - Polygon surfaces
+  - Deterministic samplers for spheres, boxes, etc.
+
+Some of these things we should leave out or keep in their own modules. We want a
+compact and precise library, not something stuffed with every arbitrary
+math-like function that other people are also writing all the time. We want to
+show that we can integrate things. We don't want to provide all the things that
+can be integrated. Or at least not at this stage. It might be worthwhile to aim
+for a larger library if the library had a group of users.
+
+We really want to keep things separate. There should pretty much be zero
+concrete types anywhere in the core set of modules.
+
+*)