hansei-symbolic-suite

Tue May 20 10:52:05+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

Tests summary

scheme code

((ran 5) (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.013) (memory #(6291456 1431888 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 1390304 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.039) (memory #(6291456 1331664 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.047) (memory #(6291456 1775888 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}) \to {(p - 1)}^{2} p \\ p ({s, f, f, f, f}) \to {(p - 1)}^{4} 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.019) (memory #(6291456 1550384 1048576)) (stdout "") (stderr ""))