personal/time-to-botec
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

tweak: move from array to list

Browse Source
This commit is contained in:
NunoSempere 2023-10-15 00:33:59 +01:00
parent 351f4c584d
commit 3950946d68
5 changed files with 25 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
ocaml/out/samples
View File

Binary file not shown.

BIN
ocaml/out/samples.cmi
View File

Binary file not shown.

BIN
ocaml/out/samples.cmx
View File

Binary file not shown.

BIN
ocaml/out/samples.o
View File

Binary file not shown.

36
ocaml/samples.ml
View File

@ -2,17 +2,27 @@
let pi = acos (-1.) let pi = acos (-1.)
let normal_95_ci_length = 1.6448536269514722 let normal_95_ci_length = 1.6448536269514722
(* Array manipulation helpers *) (* List manipulation helpers *)
let sumFloats xs = Array.fold_left(fun acc x -> acc +. x) 0.0 xs let sumFloats xs = List.fold_left(fun acc x -> acc +. x) 0.0 xs
let normalizeXs xs = let normalizeXs xs =
let sum_xs = sumFloats xs in let sum_xs = sumFloats xs in
Array.map(fun x -> x /. sum_xs) xs List.map(fun x -> x /. sum_xs) xs
let cumsumXs xs = let cumsumXs xs =
let _, cum_sum = Array.fold_left(fun (sum, ys) x -> let _, cum_sum = List.fold_left(fun (sum, ys) x ->
let new_sum = sum +. x in let new_sum = sum +. x in
new_sum, ys @ [new_sum] new_sum, ys @ [new_sum]
) (0.0, []) xs in ) (0.0, []) xs in
cum_sum cum_sum
let rec nth xs (n: int) =
match xs with
| [] -> None
| y :: ys -> if n = 0 then Some(y) else nth ys (n-1)
(*
Note that this is O(n) access.
That is the cost of using the nice match syntax,
which is not possible with OCaml arrays
*)
let findIndex xs test = let findIndex xs test =
let rec recursiveHelper ys i = let rec recursiveHelper ys i =
match ys with match ys with
@ -41,18 +51,22 @@ let sampleTo low high =
let logstd = (loghigh -. loglow) /. (2.0 -. normal_95_ci_length ) in let logstd = (loghigh -. loglow) /. (2.0 -. normal_95_ci_length ) in
sampleLognormal logmean logstd sampleLognormal logmean logstd
let mixture (samplers: (unit -> float) array) (weights: float array): float option = let mixture (samplers: (unit -> float) list) (weights: float list): float option =
if (Array.length samplers == Array.length weights) if (List.length samplers == List.length weights)
then None then None
else else
let normalized_weights = normalizeXs weights in let normalized_weights = normalizeXs weights in
let cumsummed_normalized_weights = cumsumXs normalized_weights in let cumsummed_normalized_weights = cumsumXs normalized_weights in
let p = sampleZeroToOne () in let p = sampleZeroToOne () in
let chosenSamplerIndex = findIndex cumsummed_normalized_weights (fun x -> x < p) in let chosenSamplerIndex = findIndex cumsummed_normalized_weights (fun x -> x < p) in
let sample = match chosenSamplerIndex with let sampler = match chosenSamplerIndex with
| None -> None | None -> None
| Some(i) -> Some (samplers.(i) ()) | Some(i) -> nth samplers i
in in
let sample = match sampler with
| None -> None
| Some(f) -> Some(f ())
in
sample sample
let () = let () =
@ -63,9 +77,9 @@ let () =
let p1 = 0.8 in let p1 = 0.8 in
let p2 = 0.5 in let p2 = 0.5 in
let p3 = p1 *. p2 in let p3 = p1 *. p2 in
let weights = [| 1. -. p3; p3 /. 2.; p3 /. 4.; p3/. 4. |] in let weights = [ 1. -. p3; p3 /. 2.; p3 /. 4.; p3/. 4. ] in
let sampler () = mixture [| sample0; sample1; sampleFew; sampleMany |] weights in let sampler () = mixture [ sample0; sample1; sampleFew; sampleMany ] weights in
let n = 1_000_000 in let n = 1_000_000 in
let samples = Array.init n (fun _ -> sampler ()) in let samples = List.init n (fun _ -> sampler ()) in
(* let mean = sumFloats samples /. n in *) (* let mean = sumFloats samples /. n in *)
Printf.printf "Hello world\n" Printf.printf "Hello world\n"