Wishful Thinking Models

Table of Contents


1 Computational Models

1.1 Utilities

1.2 Simple Wishful Thinking

1.2.1 Experiment 1

Explicit Enumeration for both inner and outer query

;;; load js functions ;;;
(load './beta-score.js)

;;; helper functions ;;;
(define (factorial n)
  (if (eq? n 0)
      1
      (* n (factorial (- n 1)))))

(define (dbeta x m c)
  (let ((a  (* m c))
        (b (* (- 1 m) c)))
    (exp (betaScore (list a b) x))))

(define (my-round x)
  (if (equal? x .5)
      (if (flip) 0 1)
      (round x)))

(define (expectation dist)
  (sum (apply map (pair * dist))))

(define (cartesian-product . lists)
  (fold (lambda (xs ys)
          (apply append
                 (map (lambda (x)
                        (map (lambda (y)
                               (pair x y))
                             ys))
                      xs)))
        '(())
        lists))

(define (combo n k)
  (/ (factorial n) (* (factorial k) (factorial (- n k)))))

(define (binomial weight xn)
  (let ([n (+ 1 xn)])
    (multinomial (iota n 0) (map (lambda (x) (bin_prob weight n x)) (iota n 0)))))

(define (observe weight ndata obs)
  (flip (bin_prob weight ndata obs)))

(define (bin_prob weight ndata obs)
  (define n ndata)
  (define k obs)
  (define p weight)
  (define nk (- n k))
  (define np (- 1 p))

  (* (combo n k) (expt p k) (expt np nk)))


(define (bin-weight val)
  (max .0005 (min .9995 (/ (round (* 10 val)) 10))))

(define weights
  '(.0005 .1 .2 0.3 0.4 0.5 0.6 0.7 0.8 .9 .9995))

(define (update-belief evidence-strength evidence belief)
  (flip  (expt (- 1 (abs (- evidence belief))) evidence-strength)))

;;; cognitive model ;;;
(define wt-cognitive-model
  (mem (lambda (wishful-thinking wishful-thinking-sigma evidence-strength evidence utility)
         (enumeration-query

          (define (wishful-thinking-prior wishful-thinking-mu) (multinomial weights (map (lambda (x)
                                                                                           (dbeta x wishful-thinking-mu wishful-thinking-sigma))
                                                                                         weights)))
          (define belief (if (eq? utility 0)
                             (uniform-draw weights) ; non-biased
                             (if (> utility 0)
                                 (wishful-thinking-prior (+ .5 wishful-thinking)) ; outcome is good
                                 (wishful-thinking-prior (- .5 wishful-thinking))))) ; outcome is bad

          belief

          (observe belief evidence-strength evidence)))))



(define data-analysis
  (lambda (trial-util resp)
    (enumeration-query
     (define wishful-thinking-mu (uniform-draw '(-.4 -.35 -.3 -.25 -.2 -.15 -.1 -.05 0 .05 .1 .15 .2 .25 .3 .35 .4)))
     (define wishful-thinking-sigma (uniform-draw '(1.5 2 2.5 3 3.5)))
     (define predictions (map (lambda (xtrial-util xresp)
                                (let ((dist (apply zip (wt-cognitive-model wishful-thinking-mu wishful-thinking-sigma 10 5 xtrial-util))))
                                  (log (second (list-ref dist (list-index weights (bin-weight xresp)))))))
                              trial-util resp))

     (define score-predictions
       (map factor predictions))

     wishful-thinking-mu

     #t)))



;;; e1 ;;;

(define data (read-csv './data/pov1_data.csv))
(define response (map string->number (map second data)))
(define trial-utility (map string->number (map first data)))

(define wt (data-analysis trial-utility response))
(write-csv wt 'results/e1_e2e.csv ",")

;;; e3 ;;;
(define data (read-csv './data/pov3_data.csv))
(define response (map string->number (map second data)))
(define trial-utility (map string->number (map first data)))

(define wt (data-analysis trial-utility response))
(write-csv wt 'results/e3_e2e.csv ",")

Smoothed histogram

233.png

1.2.2 Experiment 2

Explicit Enumeration for both inner and outer query

(load './beta-score.js)

(define (dbeta x m c)
  (let ((a  (* m c))
        (b (* (- 1 m) c)))
    (exp (betaScore (list a b) x))))


;;; helper functions
(define (factorial n)
  (if (eq? n 0)
      1
      (* n (factorial (- n 1)))))

(define (combo n k)
  (/ (factorial n) (* (factorial k) (factorial (- n k)))))

(define (binomial weight xn)
  (let ([n (+ 1 xn)])
    (multinomial (iota n 0) (map (lambda (x) (bin_prob weight n x)) (iota n 0)))))

(define (observe weight ndata obs)
  (flip (bin_prob weight ndata obs)))

(define (bin_prob weight ndata obs)
  (define n ndata)
  (define k obs)
  (define p weight)
  (define nk (- n k))
  (define np (- 1 p))

  (* (combo n k) (expt p k) (expt np nk)))

(define (my-round x)
  (if (equal? x .5)
      (if (flip) 0 1)
      (round x)))

(define (gammaF n)
  (factorial (- n 1)))

(define (my-round x)
  (if (equal? x .5)
      (if (flip) 0 1)
      (round x)))

(define (expectation dist)
  (sum (apply map (pair * dist))))

(define (cartesian-product . lists)
  (fold (lambda (xs ys)
          (apply append
                 (map (lambda (x)
                        (map (lambda (y)
                               (pair x y))
                             ys))
                      xs)))
        '(())
        lists))

(define (bin-weight val)
  (max .0005 (min .9995 (/ (round (* 10 val)) 10))))

(define weights
  '(.0005 .1 .2 0.3 0.4 0.5 0.6 0.7 0.8 .9 .9995))

  ;;; cognitive model ;;;
(define (update-belief evidence-strength evidence belief)
  (flip  (expt (- 1 (abs (- evidence belief))) evidence-strength)))


(define fan
  (mem (lambda (wishful-thinking wishful-thinking-sigma evidence-strength evidence utility)
         (enumeration-query

          (define (wishful-thinking-prior wishful-thinking-mu)
            (multinomial weights (map (lambda (x)
                                        (dbeta x wishful-thinking-mu wishful-thinking-sigma))
                                      weights)))

          (define belief (if (eq? utility -1)
                             (uniform-draw weights) ; non-biased
                             (if (> utility 0)
                                 (wishful-thinking-prior (+ .5 wishful-thinking)) ; outcome is good
                                 (wishful-thinking-prior (- .5 wishful-thinking))))) ; outcome is bad


          (define act (uniform-draw '(0 1)))
          (define result (my-round belief))


          act

          (and (observe belief evidence-strength evidence)
               (equal? act result))))))

(define learner
  (mem (lambda (wishful-thinking wt-sigma fan-evidence-strength fan-utility observed-fan-action)
         (enumeration-query

          (define belief (uniform-draw weights))
          (define fan-evidence (binomial belief fan-evidence-strength))
          (define fan-action (apply multinomial (fan wishful-thinking wt-sigma fan-evidence-strength fan-evidence fan-utility)))

          belief

          (equal? fan-action observed-fan-action)))))

(define data-analysis
  (lambda (bias resp)
    (enumeration-query
             (define wishful-thinking (uniform-draw '(-.1 -.075 -.025 0 .025 .05 .075 .1 .125 .15 .175 .2 .225 .25 .275 .3 .325 .35 .375 .4 .425 .45 .475 .49999)))
              (define wishful-thinking-sigma (uniform-draw '(1.5 2 2.5 3 3.5)))

              (define predictions (map (lambda (xbias xresp)
                                         (let ((dist (apply zip (learner wishful-thinking wishful-thinking-sigma 10 xbias 1))))
                                           (log (second (list-ref dist (list-index weights (bin-weight xresp)))))))
                                       bias resp))

              (define score-predictions
                (map factor predictions))

              wishful-thinking

              #t)))

(define data (read-csv './data/e2_data.csv))

(define response (map string->number (map second data)))
(define bias (map string->number (map first data)))

(define wt (data-analysis bias response))
(write-csv wt 'results/e2_e2e.csv ",")

Smoothed histogram

214.png

1.2.3 Combined

smoothed histogram

82.png

histogram

248.png