ProPL: 14 January, 2016

2.7.scm

;; by conditioning on A, note that we could also condition on B first if desired
(define (ab)
  (define a (flip 0.8))
  (define b (if a (flip 0.5) (flip 0.3)))
  (list a b)
  )
(hist (repeat 1000 ab) "joint AB by conditioning on A")

;; alternative solution
(define (joint-ab)
  (define val (uniform 0 1))
  (if (<= val 0.14)
      (list #f #f)
      (if (<= val 0.2)
          (list #f #t)
          (if (<= val 0.6)
              (list #t #f)
              (list #t #t)))))
(hist (repeat 1000 joint-ab) "joint AB")

;; using 'cond' statement
(define (joint-ab-cond)
  (define val (uniform 0 1))
  (cond ((<= val 0.14) (list #f #f))
        ((<= val 0.20) (list #f #t))
        ((<= val 0.60) (list #t #f))
        (else (list #t #t))))
(hist (repeat 1000 joint-ab-cond) "joint AB w/ cond")

birthday-problem.scm

;; What is the probability that in a room filled with N people, at least one pair
;; of people has the same birthday?
(define N 23)

(define (two-birthdays-match?)
  (rejection-query
   
   ;;;generative-model:
   ;; Q: why should this be defined within the scope of rejection-query?
   (define birthday
     (mem (lambda (i) (+ (sample-integer 365) 1)))
     ;; assume that the birthdays are uniformly distributed; ignore leap years
     )   
   
   (define (any-pair-equal?)
     (define (pair-equal i j)
       "compare all pairs starting from a given value of i and j"
       (if (> i N) 
           false
           (if (> j N)
               (pair-equal (+ i 1) (+ i 2))
               (if (= (birthday i) (birthday j)) 
                   true
                   (pair-equal i (+ j 1))))))
     ;; start comparing from the first pair
     (pair-equal 1 2))
   ;;;
   
   ;;;unknown:
   (any-pair-equal?)
   ;;;
   
   ;;;known - i.e., no conditioning:
   #t
   ;;;
   ))

(hist (repeat 1000 two-birthdays-match?))

church-tutorial.scm

;; try the code at https://probmods.org/play-space.html

;; deterministic function: sqrt
(sqrt 4) ;; 2

;; non-deterministic function: flip (i.e., flipping a weighted coin)
;; invoke it w/ default argument (i.e., flipping a fair coin)
(flip)
;; invoke it passing in an argument for probability of #t
(flip 0.01)

;; define: use it to bind values to symbols
;; >> pi
;; this will give an error because "pi" hasn't been defined yet
;; 8:1-8:2: pi is not defined
;;
;; Church stack array:
;; pi: 8:1-8:2
;; JS stack:
;; ReferenceError: pi is not defined
;;     at churchProgram (eval at really_evaluate (https://probmods.org/webchurch/online/webchurch.min.js:3:29182), <anonymous>:16:12)
;;     at eval (eval at really_evaluate (https://probmods.org/webchurch/online/webchurch.min.js:3:29182), <anonymous>:17:2)
;;     at really_evaluate (https://probmods.org/webchurch/online/webchurch.min.js:3:29177)
;;     at evaluate (https://probmods.org/webchurch/online/webchurch.min.js:3:29972)
;;     at https://probmods.org/webchurch/online/webchurch.min.js:3:21348
;;     at Backbone.Model.extend.run (https://probmods.org/webchurch/online/webchurch.min.js:3:25300)
;;     at https://probmods.org/webchurch/online/webchurch.min.js:3:24467

;; let's define "pi" as a constant
(define pi 3.1415926)
pi ;; invoke value of constant pi

;; church has some builtins eg. sqrt
(sqrt 4) ;; 2

;; but it doesn't have a square function. let's define 'sq' to be a function
(define sq 
  (lambda (x) ;; syntax for defining anonymous function
    (* x x) ;; note prefix notation. the function '*' is applied to 'x' and 'x'
    )
  )

(sq 2) ;; 4

;; we can do the above in fewer steps
(define (sq1 x) ;; define sq1 as a function of one argument. it's equivalent to the above
  (* x x))

(sq1 3) ;; 9

;; define lists
(list 0 1 1 1 0 0)
(list (flip) (flip) (flip) (flip))

;; plot a histogram of lists
(hist (list (flip) (flip) (flip) (flip)) "title: hist of flips")


;; we can plot real values too
(hist (list 0.1 0.1 0.11 0.2 0.0 0.4 0.5 0.8) "title: hist of reals")
;; for continuous distributions however we can also plot density
(density (list 0.1 0.1 0.11 0.2 0.0 0.4 0.5 0.8) "title: density of reals")
(density (list 0.1 0.1 0.11 0.2 0.0 0.4 0.5 0.8) "title: density of reals w/hist" #t)

;; function which operates on other functions: eg 'repeat'
;; create a list with the output of repeated function calls
(hist (repeat 100 flip) "title: hist of 100 flips")

;; memoization: remember settings
;; w/o memoization. in this case eye-color rolls the dice everytime
(define eye-color
  (lambda (person) (uniform-draw '(blue green brown))))
(list
 (eye-color 'bob)
 (eye-color 'alice)
 (eye-color 'bob))

;; with memoization. in this case eye-color-mem rolls the dice for the first time for each "person", and 
;; remembers for the next time
(define eye-color-mem
  (mem (lambda (person) (uniform-draw '(blue green brown)))))
(list
 (eye-color-mem 'bob)
 (eye-color-mem 'alice)
 (eye-color-mem 'bob))

;; stochastic recursion: like regular recursion, except functions are non-deterministic
(define (geometric p)
  "(the number of coin tosses needed to yield #t) - 1"
  (if (flip p)
      0 ;; if cointoss resulted in true
      (+ 1 (geometric p)) ;; else increment counter, and try again
      ))

(hist (repeat 1000 (lambda () (geometric 0.6))) "Geometric of 0.6")