This is a Church implementation of a model in Ref:Griffiths2005.

In principle, the likelihood evaluation involves many `flip`s, but for efficiency we collapse them into a single `flip` whose weight is the product of all the weights of the individual `flip`s.

``````;; data is an association list that maps pairs of (c,e) of 0/1-valued tuples onto frequencies
;; e.g., '((0 1) 8) indicates that the event of cause-off-with-event-on happened 8 times
(define (output data)
(define samples
(mh-query
10000 1

;; strengths
(define w0 (uniform 0 1))
(define w1 (uniform 0 1))

;; graph likelihood functions for p(e+ | c)
;; noisy-and
;;(define (p1 c) (* w0 (expt w1 c)))

;; noisy-or
(define (p1 c) (- 1 (* (- 1 w0) (expt (- 1 w1) c))  ) )

(define (p0 c) w0)

;; prior doesn't really matter
(define graph0? (flip) )

(define likelihood-fn (if graph0? p0 p1))

;; collapse all flips into a single flip
;; by multiplying their individual probabilities
(define weight
(prod
(map
(lambda (lst)
(let* ((c (first (first lst)))
(e (second (first lst)))
(N (second lst))
(pe+ (likelihood-fn c))
(p (if (= e 1) pe+ (- 1 pe+))))
(expt p N)))
data)))

;; desired: whether or not we believe there's a causal relationship
;; between c and e
(if graph0? 0 1)

;; condition: flip weight ~ flip likelihood (product of lik over {c+, c-} x {e+, e-})
(flip weight)
))
(display (mean samples)))

(output '([(0 0) 0] [(0 1) 8] [(1 0) 0] [(1 1) 8] ))
(output '([(0 0) 2] [(0 1) 6] [(1 0) 2] [(1 1) 6] ))
(output '([(0 0) 4] [(0 1) 4] [(1 0) 4] [(1 1) 4] ))
(output '([(0 0) 6] [(0 1) 2] [(1 0) 6] [(1 1) 2] ))
(output '([(0 0) 8] [(0 1) 0] [(1 0) 8] [(1 1) 0] ))

(output '([(0 0) 0] [(0 1) 6] [(1 0) 0] [(1 1) 8] ))
(output '([(0 0) 2] [(0 1) 4] [(1 0) 2] [(1 1) 6] ))
(output '([(0 0) 4] [(0 1) 2] [(1 0) 4] [(1 1) 4] ))
(output '([(0 0) 6] [(0 1) 0] [(1 0) 6] [(1 1) 2] ))

(output '([(0 0) 4] [(0 1) 4] [(1 0) 0] [(1 1) 8] ))
(output '([(0 0) 6] [(0 1) 2] [(1 0) 2] [(1 1) 6] ))
(output '([(0 0) 8] [(0 1) 0] [(1 0) 4] [(1 1) 4] ))

(output '([(0 0) 6] [(0 1) 2] [(1 0) 0] [(1 1) 8] ))
(output '([(0 0) 8] [(0 1) 0] [(1 0) 2] [(1 1) 6] ))
(output '([(0 0) 8] [(0 1) 0] [(1 0) 0] [(1 1) 8] ))
``````

References:

• Cite:Griffiths2005