;; Defines a way to express noisy-or assumption in Bayes nets.

(define (make-noisy-or-array node parents causal-probs leak-prob)
  ;; Creates a conditional probability table that implements the
  ;; noisy-or assumption.  This concept is well-defined only in the
  ;; case of all binary variables.  Causal-probs holds a list of the
  ;; "causal" probabilities of node given each of its parents.
  (define (probability? p)
    (and (real? p) (<= 0.0 p 1.0)))
  (define (pnot vals)
    ;; Computes the probability (under the noisy-or assumption) that
    ;; node is FALSE given the assignments of values to its parents in
    ;; vals.  Each TRUE parent contributes a factor of (1 - cp) where
    ;; cp is the causal probability from that parent to the node.
    ;; FALSE parents contribute nothing.
    (let iter ((vl vals) (cpl causal-probs) (ans 1.0))
      (if (null? vl)
          ans
          (iter (cdr vl) (cdr cpl) 
                (if (zero? (car vl)) 
                    ans 
                    (* (- 1.0 (car cpl)) ans))))))
  (define (inner nodes val-list)
    (if (null? nodes)
        ;; Leaves of the tree
        ;; Probability of 
        (let ((not-prob (* (pnot val-list) (- 1.0 leak-prob))))
          (list not-prob (- 1.0 not-prob)))
        (list (inner (cdr nodes) (append val-list (list 0)))
              (inner (cdr nodes) (append val-list (list 1))))))
  (let ((nodes (append parents (list node))))
    (if (or (not (= (length parents) (length causal-probs)))
            (not (every? causal-probs probability?))
            (not (probability? leak-prob))
            (not (every? nodes (lambda (n) (= (bn-n-values n) 2)))))
        (error 'make-noisy-or-array
               "Error making noisy-or array"))
    (make-array (normalize-cdists (inner parents '())))))

(make-noisy-or-array (bnet-node-named 'd mcbn1)
                     (list (bnet-node-named 'b mcbn1)
                           (bnet-node-named 'c mcbn1))
                     
                     '(.8 .7)
                     .00)