Edit page

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

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

;; 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: