Edit page

This sequence of models is based on Ref:costello2014surprisingly.

Unbiased probability estimation for p=.5:

(define (bool-sum lst)
  (sum (map boolean_to_number lst)))

(define (noisify flag noise-prob)
  (or 
   (and flag (flip (- 1 noise-prob)))
   (and (not flag) (flip noise-prob))))

(define (noisy-probability episodes noise true-prob)
  (/ (bool-sum 
      (repeat episodes 
              (lambda () (noisify (flip true-prob) noise))))
     episodes))

(define (expected-noisy-probability episodes noise true-prob)
  (mean
   (repeat 1000 
           (lambda () (noisy-probability episodes noise true-prob)))))

(define estimate
  (noisy-probability 10000 0.25 0.5))
  
(barplot
 (list
  (list "estimated p" "estimated 1-p")
  (list estimate (- 1 estimate)))
 "Unbiased probability estimate when p=0.5")

Conservatism towards the ends of the scale:

;;;fold:

(define (bool-sum lst)
  (sum (map boolean_to_number lst)))

(define (noisify flag noise-prob)
  (or 
   (and flag (flip (- 1 noise-prob)))
   (and (not flag) (flip noise-prob))))

(define (noisy-probability episodes noise true-prob)
  (/ (bool-sum 
      (repeat episodes 
              (lambda () (noisify (flip true-prob) noise))))
     episodes))

(define (expected-noisy-probability episodes noise true-prob)
  (mean
   (repeat 1000 
           (lambda () (noisy-probability episodes noise true-prob)))))
;;;

(barplot
 (list
  (list .1 .5 .9) 
  (map (lambda (p) (expected-noisy-probability 100 0.25 p))
       (list .1 .5 .9)))
 "Conservatism")

Subadditivity:

;;;fold:

(define (bool-sum lst)
  (sum (map boolean_to_number lst)))

(define (noisify flag noise-prob)
  (or 
   (and flag (flip (- 1 noise-prob)))
   (and (not flag) (flip noise-prob))))

(define (noisy-probability episodes noise true-prob)
  (/ (bool-sum 
      (repeat episodes 
              (lambda () (noisify (flip true-prob) noise))))
     episodes))

(define (expected-noisy-probability episodes noise true-prob)
  (mean
   (repeat 1000 
           (lambda () (noisy-probability episodes noise true-prob)))))
;;;

(define two-state-dist (list 0.3 0.7))
(define three-state-dist (list 0.3 0.4 0.3))
(define five-state-dist (list 0.3 0.2 0.05 0.2 0.25))

(define (sum-of-expectations dist)
  (sum (map (lambda (p) (expected-noisy-probability 100 0.25 p)) dist)))

(barplot
 (list 
  (list "two states" "three states" "five states")
  (map sum-of-expectations
       (list two-state-dist
             three-state-dist
             five-state-dist)))
 "Subadditivity")

Conjunction fallacy. This is supposedly highest when P(A) is low, P(A|B) and P(B) is high; or when P(A) is almost the same as P(A & B).

;;;fold:

(define (bool-sum lst)
  (sum (map boolean_to_number lst)))

(define (noisify flag noise-prob)
  (or 
   (and flag (flip (- 1 noise-prob)))
   (and (not flag) (flip noise-prob))))

(define (noisy-probability episodes noise true-prob)
  (/ (bool-sum 
      (repeat episodes 
              (lambda () (noisify (flip true-prob) noise))))
     episodes))

(define (expected-noisy-probability episodes noise true-prob)
  (mean
   (repeat 1000 
           (lambda () (noisy-probability episodes noise true-prob)))))
;;;

(define (conjunction-fallacy? a a&b episodes noise)
  (< (noisy-probability episodes noise a)
     (noisy-probability episodes noise a&b)))

(define max-a|b (lambda (a b) (/ a b)))

(define a&b (lambda (a|b b) (* a|b b)))

(hist (repeat 1000 
              (lambda () 
                (conjunction-fallacy? 0.1 (a&b (max-a|b 0.1 0.9) 0.9) 100 0.25))) 
      "Conjunction fallacy ('optimal' conditions)")

(hist (repeat 1000 
              (lambda () 
                (conjunction-fallacy? 0.75 0.4 100 0.25)))
      "No conjunction fallacy ('bad' conditions)")

References: