hansei-symbolic-suite

Fri May 16 11:55:45+0200 2025

This work is licensed under a Creative Commons Attribution-ShareAlike 4.0 International License

Table of contents

Symbolic
test/coin-model: pass
test/coin-model/observed: pass
test/grass-model: pass
test/grass-model/joint: pass
test/geometric: pass
test/flip: pass
test/flip-xor-model/middle: pass
test/flip-xor-model/bucket: pass

Tests summary

scheme code

((ran 8) (failed 0))

1. Symbolic

2. `test/coin-model`: pass

Joint distribution of tossing two coins, where head has probability $p$ to appear:

(⁠ \begin{array}{c} Prob (True, False) \to - ((p - 1) p) \\ Prob (False, True) \to - ((p - 1) p) \\ Prob (False, False) \to {(p - 1)}^{2} \\ Prob (True, True) \to p^{2} \end{array} ⁠)

observe that both proportional and normalized probabilities are the same because there is no observation that rules out some branches, therefore the normalization constant equals $1$ .

scheme code

(define (test/coin-model _)
  (define result
    (probcc-reify/exact
      (let* ((p 'p) (x (probcc-coin p)) (y (probcc-coin p)))
        `((x ,x) (y ,y)))))
  (⊦= '(((V ((x #t) (y #f))) (Times -1 (Plus -1 p) p))
          ((V ((x #f) (y #t))) (Times -1 (Plus -1 p) p))
          ((V ((x #f) (y #f))) (Power (Plus -1 p) 2))
          ((V ((x #t) (y #t))) (Power p 2)))
        result)
  (⊦= result (probcc-normalize result)))

scheme code

((eta 0.009) (memory #(6291456 1543272 1048576)) (stdout "") (stderr ""))

3. `test/coin-model/observed`: pass

Slightly variation of the previous test, here it has been observed that at least one head appeared. Now the probabilities are proportional according to the following rules:

(⁠ \begin{array}{c} Prob (True, False) \to - ((p - 1) p) \\ Prob (False, True) \to - ((p - 1) p) \\ Prob (True, True) \to p^{2} \end{array} ⁠)

and they can be normalized,

(⁠ \begin{array}{c} Prob (True, False) \to \frac{p - 1}{p - 2} \\ Prob (False, True) \to \frac{p - 1}{p - 2} \\ Prob (True, True) \to - \frac{p}{p - 2} \end{array} ⁠)

to obtain a valid probability distribution, provided that the assumed observation occurred.

scheme code

(define (test/coin-model/observed _)
  (define result
    (probcc-reify/exact
      (let* ((p 'p) (x (probcc-coin p)) (y (probcc-coin p)))
        (probcc-when (or x y) `((x ,x) (y ,y))))))
  (define normalized (probcc-normalize result))
  (⊦= '(((V ((x #t) (y #f))) (Times -1 (Plus -1 p) p))
          ((V ((x #f) (y #t))) (Times -1 (Plus -1 p) p))
          ((V ((x #t) (y #t))) (Power p 2)))
        result))

scheme code

((eta 0.015) (memory #(6291456 1500144 1048576)) (stdout "") (stderr ""))

4. `test/grass-model`: pass

The conditional probability that rained given that a wet grass has been observed is

\frac{r (e (w - 1) (s v - 1) + s (v - v w) + w)}{e (r w - 1) (s v - 1) + s (v - r v w) + r w}

fully symbolic. On the other hand, the rules

(⁠ \begin{array}{c} r \to 0.3 \\ s \to 0.5 \\ w \to 0.9 \\ v \to 0.8 \\ e \to 0.1 \end{array} ⁠)

allow us to get numerical values according to the expected results already shown.

scheme code

(define (test/grass-model _)
  (define result
    (probcc-reify/exact
      (let* ((rain (probcc-coin 'r))
             (sprinkler (probcc-coin 's))
             (grass-is-wet
               (or (and (probcc-coin 'w) rain)
                   (and (probcc-coin 'v) sprinkler)
                   (probcc-coin 'e))))
        (probcc-when grass-is-wet `(rain ,rain)))))
  (define normalized (probcc-normalize result))
  (define p/rain (second (first normalized)))
  (define p/not-rain (second (second normalized)))
  (define rules
    '(List (Rule r 0.3) (Rule s 0.5) (Rule w 0.9) (Rule v 0.8) (Rule e 0.1)))
  (⊦= '(((V (rain #t))
           (Times r
                  (Plus (Times e (Plus -1 (Times s v)) (Plus -1 w))
                        w
                        (Times s (Plus v (Times -1 v w))))))
          ((V (rain #f))
           (Times (Plus -1 r)
                  (Plus (Times -1 s v) (Times e (Plus -1 (Times s v)))))))
        result)
  (⊦= '(((V (rain #t)) 0.2838) ((V (rain #f)) 0.322))
        (letmap ((p result)) `(,(car p) ,(W `(ReplaceAll ,(cadr p) ,rules))))))

scheme code

((eta 0.036) (memory #(6291456 1441648 1048576)) (stdout "") (stderr ""))

5. `test/grass-model/joint`: pass

If we remove the observation

scheme code

(probcc-when grass-is-wet `(rain ,rain))

from the previous test, then we can show the joint distribution

(⁠ \begin{array}{c} p (True, True, True) \to r s (e (v - 1) (w - 1) + v (- w) + v + w) \\ p (True, False, True) \to r (s - 1) (e (w - 1) - w) \\ p (False, True, True) \to (r - 1) s (e (v - 1) - v) \\ p (True, True, False) \to - ((e - 1) r s (v - 1) (w - 1)) \\ p (True, False, False) \to - ((e - 1) r (s - 1) (w - 1)) \\ p (False, True, False) \to - ((e - 1) (r - 1) s (v - 1)) \\ p (False, False, False) \to - ((e - 1) (r - 1) (s - 1)) \\ p (False, False, True) \to e (r - 1) (s - 1) \end{array} ⁠)

where $p rain sprinkler grass-is-wet$ is the non-normalized probability density function.

scheme code

(define (test/grass-model/joint _)
  (define result
    (probcc-reify/exact
      (let* ((rain (probcc-coin 'r))
             (sprinkler (probcc-coin 's))
             (grass-is-wet
               (or (and (probcc-coin 'w) rain)
                   (and (probcc-coin 'v) sprinkler)
                   (probcc-coin 'e))))
        `((rain ,rain) (sprinkler ,sprinkler) (grass-is-wet ,grass-is-wet)))))
  (define normalized (probcc-normalize result))
  (⊦= '(((V ((rain #t) (sprinkler #t) (grass-is-wet #t)))
           (Times r
                  s
                  (Plus v (Times e (Plus -1 v) (Plus -1 w)) w (Times -1 v w))))
          ((V ((rain #t) (sprinkler #f) (grass-is-wet #t)))
           (Times r (Plus -1 s) (Plus (Times e (Plus -1 w)) (Times -1 w))))
          ((V ((rain #f) (sprinkler #t) (grass-is-wet #t)))
           (Times (Plus -1 r) s (Plus (Times e (Plus -1 v)) (Times -1 v))))
          ((V ((rain #t) (sprinkler #t) (grass-is-wet #f)))
           (Times -1 (Plus -1 e) r s (Plus -1 v) (Plus -1 w)))
          ((V ((rain #t) (sprinkler #f) (grass-is-wet #f)))
           (Times -1 (Plus -1 e) r (Plus -1 s) (Plus -1 w)))
          ((V ((rain #f) (sprinkler #t) (grass-is-wet #f)))
           (Times -1 (Plus -1 e) (Plus -1 r) s (Plus -1 v)))
          ((V ((rain #f) (sprinkler #f) (grass-is-wet #f)))
           (Times -1 (Plus -1 e) (Plus -1 r) (Plus -1 s)))
          ((V ((rain #f) (sprinkler #f) (grass-is-wet #t)))
           (Times e (Plus -1 r) (Plus -1 s))))
        result))

scheme code

((eta 0.042) (memory #(6291456 1923448 1048576)) (stdout "") (stderr ""))

6. `test/geometric`: pass

(⁠ \begin{array}{c} p ({s, f, f, f}) \to - {(p - 1)}^{3} p \\ p (a1373) \to - {(p - 1)}^{5} p \\ p ({s, f, f, f, f}) \to {(p - 1)}^{4} p \\ p ({s, f, f}) \to {(p - 1)}^{2} p \\ p (a1373) \to - {(p - 1)}^{7} \\ p (a1373) \to {(p - 1)}^{6} p \\ p ({s, f}) \to - ((p - 1) p) \\ p ({s}) \to p \end{array} ⁠)

scheme code

(define (test/geometric _)
  (define result ((probcc-reify 5) (τ (probcc-geometric 'p 's 'f))))
  (define t6 (cadr (car (sixth result))))
  (define t7 (cadr (car (seventh result))))
  (define t8 (cadr (car (eighth result)))))

scheme code

((eta 0.023) (memory #(6291456 1702096 1048576)) (stdout "") (stderr ""))

7. `test/flip`: pass

512 p^{10} - 2560 p^{9} + 5760 p^{8} - 7680 p^{7} + 6720 p^{6} - 4032 p^{5} + 1680 p^{4} - 480 p^{3} + 90 p^{2} - 10 p + 1

scheme code

(define (test/flip _)
  (define-τ
    model
    (let loop ((p 'p) (n 10))
      (cond ((equal? 1 n) (probcc-coin p))
            (else (not (equal? (probcc-coin p) (loop p (sub1 n))))))))
  (define result (probcc-reify/exact (model)))
  (⊦= '(((V #f)
           (Plus (Power (Plus -1 p) 10)
                 (Times (Power p 2)
                        (Plus 45
                              (Times -360 p)
                              (Times 1470 (Power p 2))
                              (Times -3780 (Power p 3))
                              (Times 6510 (Power p 4))
                              (Times -7560 (Power p 5))
                              (Times 5715 (Power p 6))
                              (Times -2550 (Power p 7))
                              (Times 511 (Power p 8))))))
          ((V #t)
           (Times 2
                  p
                  (Plus 5
                        (Times -45 p)
                        (Times 240 (Power p 2))
                        (Times -840 (Power p 3))
                        (Times 2016 (Power p 4))
                        (Times -3360 (Power p 5))
                        (Times 3840 (Power p 6))
                        (Times -2880 (Power p 7))
                        (Times 1280 (Power p 8))
                        (Times -256 (Power p 9))))))
        result)
  (⊦= 1024 (probcc-leaves (probcc-reify/0 model))))

scheme code

((eta 2.145) (memory #(6291456 1452776 1048576)) (stdout "") (stderr ""))

8. `test/flip-xor-model/middle`: pass

Variable elimination optimization: transform a stochastic function a -> b to a generally faster function:

ocaml code

let variable_elim f arg = reflect (exact_reify (fun () -> f arg))

The probability of tail is:

512 p^{10} - 2560 p^{9} + 5760 p^{8} - 7680 p^{7} + 6720 p^{6} - 4032 p^{5} + 1680 p^{4} - 480 p^{3} + 90 p^{2} - 10 p + 1

scheme code

(define (test/flip-xor-model/middle _)
  (define (flipxor-model p)
    (letrec ((loop (λ (n)
                       (cond ((equal? 1 n) (probcc-coin p))
                             (else
                              (not (equal?
                                     (probcc-coin p)
                                     ((probcc-variable-elimination loop) (sub1 n)))))))))
      loop))
  (define res (probcc-reify/exact ((flipxor-model 'p) 10)))
  (⊦= '(((V #f)
           (Plus 1
                 (Times -10 p)
                 (Times 90 (Power p 2))
                 (Times -480 (Power p 3))
                 (Times 1680 (Power p 4))
                 (Times -4032 (Power p 5))
                 (Times 6720 (Power p 6))
                 (Times -7680 (Power p 7))
                 (Times 5760 (Power p 8))
                 (Times -2560 (Power p 9))
                 (Times 512 (Power p 10))))
          ((V #t)
           (Times 2
                  p
                  (Plus 5
                        (Times -45 p)
                        (Times 240 (Power p 2))
                        (Times -840 (Power p 3))
                        (Times 2016 (Power p 4))
                        (Times -3360 (Power p 5))
                        (Times 3840 (Power p 6))
                        (Times -2880 (Power p 7))
                        (Times 1280 (Power p 8))
                        (Times -256 (Power p 9))))))
        res))

scheme code

((eta 3.537) (memory #(6291456 1464248 1048576)) (stdout "") (stderr ""))

9. `test/flip-xor-model/bucket`: pass

512 p^{10} - 2560 p^{9} + 5760 p^{8} - 7680 p^{7} + 6720 p^{6} - 4032 p^{5} + 1680 p^{4} - 480 p^{3} + 90 p^{2} - 10 p + 1

- 512 p^{10} + 2560 p^{9} - 5760 p^{8} + 7680 p^{7} - 6720 p^{6} + 4032 p^{5} - 1680 p^{4} + 480 p^{3} - 90 p^{2} + 10 p

scheme code

(define (test/flip-xor-model/bucket _)
  (define (flipxor-model p)
    (letrec ((loop (λ-probcc-bucket
                     (n)
                     (cond ((equal? 1 n) (probcc-coin p))
                           (else
                            (not (equal?
                                   (probcc-coin ((op/subtract) 1 p))
                                   (loop (sub1 n)))))))))
      loop))
  (define res (probcc-reify/exact ((flipxor-model 'p) 10)))
  (⊦= '(((V #t)
           (Plus 1
                 (Times -10 p)
                 (Times 90 (Power p 2))
                 (Times -480 (Power p 3))
                 (Times 1680 (Power p 4))
                 (Times -4032 (Power p 5))
                 (Times 6720 (Power p 6))
                 (Times -7680 (Power p 7))
                 (Times 5760 (Power p 8))
                 (Times -2560 (Power p 9))
                 (Times 512 (Power p 10))))
          ((V #f)
           (Times 2
                  p
                  (Plus 5
                        (Times -45 p)
                        (Times 240 (Power p 2))
                        (Times -840 (Power p 3))
                        (Times 2016 (Power p 4))
                        (Times -3360 (Power p 5))
                        (Times 3840 (Power p 6))
                        (Times -2880 (Power p 7))
                        (Times 1280 (Power p 8))
                        (Times -256 (Power p 9))))))
        res))

scheme code

((eta 0.079) (memory #(6291456 1446456 1048576)) (stdout "") (stderr ""))