Commits

bergsoe  committed 9f4a6f9

Uniform sampling of unit vectors.

The contents of the Random and Sampler modules are now included into
each vector module to make it simpler to add costum sampling functions.

  • Participants
  • Parent commits f0c3560

Comments (0)

Files changed (2)

File src/PaplVector.ml

 type rng_t = PaplRandom.rng_t
 type 'a pair_t = 'a * 'a
 
+let pi = BatFloat.pi
+let pi_x_2 = 2. *. pi
+
 module type BASE = sig
   type t
+  type box_t = t * t
   val map2 : (float -> float -> float) -> t -> t -> t
   val interpolate : t PaplInterpolate.t
   val ( *: ) : float -> t -> t
   val proj_unit : t -> t -> t
 end
 
-module type RANDOM = sig
-  type t
-  type box_t = t * t
-
-  val uniform : ?rng:rng_t -> box_t -> t
-end
-
 module type SAMPLER = sig
   type t
-  type box_t = t * t
+  type box_t
 
   val uniform : ?rng:rng_t -> box_t -> t PaplSampler.t
+  val get_uniform : ?rng:rng_t -> box_t -> t
 end
 
 module type BASE_OP = sig
 
 module MakeBase (M : BASE_OP) = struct
   type t = M.t
+  type box_t = t * t
 
   let map = M.map
   let map2 = M.map2
   include PaplVectorMetric.Make (MetricOp)
 end
 
-module MakeRandom (V : BASE) (M : BASE_OP with type t = V.t) = struct
+module MakeSampler (V : BASE) (M : BASE_OP with type t = V.t) = struct
   type t = V.t
-  type box_t = t * t
 
   open V
 
   let random_offset float_fun a d =
     M.map2 (fun ai di -> ai +. float_fun di) a d
 
-  let uniform_helper float_fun (a, b) =
+  let get_uniform_helper float_fun (a, b) =
     let d = b -: a
     in random_offset float_fun a d
 
-  let uniform ?rng box = uniform_helper (PaplRandom.float ?rng) box
-end
-
-module MakeSampler (V : BASE) (M : BASE_OP with type t = V.t) = struct
-  type t = V.t
-  type box_t = t * t
-
-  open V
-
-  let random_offset float_fun a d =
-    M.map2 (fun ai di -> ai +. float_fun di) a d
-
   let uniform_helper float_fun (a, b) =
     let d = b -: a in
-    let next () = Some (random_offset float_fun a d)
-    in BatEnum.from_while next
+    let next () = random_offset float_fun a d
+    in BatEnum.from next
+
+  let get_uniform ?rng =
+    let float_fun = PaplRandom.float ?rng in
+      fun box -> get_uniform_helper float_fun box
 
-  let uniform ?rng box = uniform_helper (PaplRandom.float ?rng) box
+  let uniform ?rng box =
+    let float_fun = PaplRandom.float ?rng in
+      uniform_helper float_fun box
 end
 
 (* Vector accessors *)
 
   include DOT with type t := t
   include PaplVectorMetric.S with type t := t and type weight_t = t
-
-  module Random : RANDOM with type t = t
-  module Sampler : SAMPLER with type t = t
+  include SAMPLER with type t := t and type box_t := box_t
 end
 
 module MakeAll (Op : BASE_OP) = struct
   include (MakeDot (Base) (Op) : DOT with type t := t)
   include (MakeMetric (Op) :
              PaplVectorMetric.S with type t := t and type weight_t = t)
-
-  module Random = MakeRandom (Base) (Op)
-  module Sampler = MakeSampler (Base) (Op)
+  include (MakeSampler (Base) (Op) :
+             SAMPLER with type t := t and type box_t := box_t)
 end
 
 (* module V2D = MakeAll(V2DOp) *)
   type triangle_t = t * t * t
   type triangle_geom_t = triangle_t array
 
-  module Random = MakeRandom (Base) (V2DOp)
-  module Sampler = MakeSampler (Base) (V2DOp)
+  include (MakeSampler (Base) (V2DOp) :
+             SAMPLER with type t := t and type box_t := box_t)
 
   type weight_t = t
   let dim _ = 2
     b0 *. c1 -. b1 *. c0,
     a1 *. c0 -. a0 *. c1,
     a0 *. b1 -. a1 *. b0
+
+  let get_uniform_unit_helper float_fun =
+    let open BatFloat in
+    let z = float_fun 2. - 1. in (* z in [-1, 1). *)
+    let a = float_fun pi_x_2 in (* a in [0, pi). *)
+    let s = Pervasives.sqrt (1. - z * z) in
+    let x = s * cos a in
+    let y = s * sin a in
+      (x, y, z)
+
+  let get_uniform_unit ?rng =
+    let float_fun = PaplRandom.float ?rng in
+      fun () -> get_uniform_unit_helper float_fun
+
+  let uniform_unit ?rng () =
+    let next = get_uniform_unit ?rng in
+      BatEnum.from next
 end
 
 module V4D = MakeAll(V4DOp)

File src/PaplVector.mli

   type t
 (** A vector configuration. *)
 
+  type box_t = t * t
+
 (** {2 Interpolation} *)
 
   val interpolate : t PaplInterpolate.t
 *)
 end
 
-(** {2 Random configurations}
-
-    These functions return single configurations.
-*)
-
-(** Random vectors *)
-module type RANDOM = sig
-  type t
-  type box_t = t * t
-
-  val uniform : ?rng:rng_t -> box_t -> t
-(** A configuration sampled uniformly at random from a box. *)
-end
-
 (** {2 Samplers} *)
 
 (** Sampling of vectors *)
 module type SAMPLER = sig
   type t
-  type box_t = t * t
+  type box_t
 
   val uniform : ?rng:rng_t -> box_t -> t PaplSampler.t
 (** Uniform sampling of a configuration space box. *)
+
+  val get_uniform : ?rng:rng_t -> box_t -> t
+(** A single configuration sampled uniformly at random from a box. *)
 end
 
 (** {2 All} *)
   include DOT with type t := t
   include PaplVectorMetric.S with type t := t and type weight_t = t
 
-  module Random : RANDOM with type t = t
-  module Sampler : SAMPLER with type t = t
+  include SAMPLER with type t := t and type box_t := box_t
 end
 
 (** {2 2D vectors} *)
 
   val cross : t -> t -> t
   (** The cross product of a pair of vectors. *)
+
+  val uniform_unit : ?rng:rng_t -> unit -> t PaplSampler.t
+  (** Unit vectors sampled uniformly at random from the surface of the unit
+      sphere.
+  *)
+
+  val get_uniform_unit : ?rng:rng_t -> unit -> t
+  (** A single unit vector sampled uniformly at random from the surface of the
+      unit sphere. *)
 end
 
 (** 4-tuples as vectors. *)