package prbnmcn-dagger-test

  1. Overview
  2. Docs

Source file sprinkler.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
open Dagger

let () = if Helpers.produce_artifacts then Cgraph.Internal.set_debug true

let rng_state = RNG.make [| 0x1337; 0x533D |]

(* ------------------------------------------------------------------------- *)
(* Using incremental inference *)

module Traced_incremental = struct
  open Lmh_incremental_inference

  let bern = Stats_dist.bernoulli

  let model : bool t =
    let open Infix in
    let*! rain = sample (bern ~bias:0.2) in
    let*! sprinkler = sample (bern ~bias:0.1) in
    let prob_lawn_wet =
      let+ r = use rain and+ s = use sprinkler in
      match (r, s) with
      | (true, true) -> 0.99
      | (true, false) -> 0.7
      | (false, true) -> 0.9
      | (false, false) -> 0.01
    in
    let+ _ = map_score prob_lawn_wet Fun.id and+ r = use rain in
    r

  let () =
    if Helpers.produce_artifacts then
      Lmh_incremental_inference.to_dot "sprinkler.dot" model

  let nsamples = 100_000

  let test =
    QCheck.Test.make
      ~name:"biased coin, traced, incremental"
      ~count:1
      QCheck.unit
    @@ fun () ->
    let samples =
      Lmh_incremental_inference.stream_samples model rng_state
      |> Helpers.drop 1000 |> Helpers.take nsamples
    in
    let freq =
      (samples
      |> Seq.map (fun x -> if x then 1 else 0)
      |> List.of_seq |> List.fold_left ( + ) 0 |> float_of_int)
      /. float_of_int nsamples
    in
    Format.printf "probability that it rains: %f@." freq ;
    abs_float (freq -. 0.64) <. 0.01
end

(* ------------------------------------------------------------------------- *)
(* Using non-incremental inference *)

module Traced = struct
  open Lmh_inference

  let model : bool t =
    let open Infix in
    let* rain = sample (Stats_dist.bernoulli ~bias:0.2) in
    let* sprinkler = sample (Stats_dist.bernoulli ~bias:0.1) in
    let prob_lawn_wet =
      match (rain, sprinkler) with
      | (true, true) -> 0.99
      | (true, false) -> 0.7
      | (false, true) -> 0.9
      | (false, false) -> 0.01
    in
    let+ () = score prob_lawn_wet in
    rain

  let nsamples = 100_000

  let test =
    QCheck.Test.make ~name:"biased coin, traced" ~count:1 QCheck.unit
    @@ fun () ->
    let samples =
      Lmh_inference.stream_samples model rng_state
      |> Helpers.drop 1000 |> Helpers.take nsamples
    in
    let freq =
      (samples
      |> Seq.map (fun x -> if x then 1 else 0)
      |> List.of_seq |> List.fold_left ( + ) 0 |> float_of_int)
      /. float_of_int nsamples
    in
    Format.printf "probability that it rains: %f@." freq ;
    abs_float (freq -. 0.64) <. 0.02
end

let tests = [Traced_incremental.test; Traced.test]