Common Lisp Think Bayes

This repository contains examples from Think Bayes book written in Common Lisp.

Requirements

Source code from this repository requires asdf to be installed.

Get code

git clone https://github.com/martinkersner/cl-think-bayes.git

Initialization

Before running any code from this repository you must run following code.

(load "init")

Chapter 1 - Bayes's Theorem

Chapter 2 - Computational Statistics

Cookie Problem

solution, example

(setf hypos '((bowl1
                ((vanilla 0.75)
                 (chocolate 0.25)))
              (bowl2
                ((vanilla 0.5)
                 (chocolate 0.5)))))

(setf cp (make-instance 'cookie :hypos hypos))
(update cp 'vanilla)
(print-solution cp)

Monty Hall Problem

solution, example

(setf hypos '(A B C))
(setf m (make-instance 'monty :hypos hypos))
(update m 'B)
(print-solution m)

M&M Problem

solution, example

(setf options '((mix94
                 ((brown  30)
                  (yellow 20)
                  (red    20)
                  (green  10)
                  (orange 10)
                  (tan    10)
                  (blue    0)))

               (mix96
                 ((brown  13)
                  (yellow 14)
                  (red    13)
                  (green  20)
                  (orange 16)
                  (tan    0)
                  (blue   24)))))

(setf m (make-instance 'm-and-m :options options
                                :hypos hypos))
(update m '(bag1 yellow))
(update m '(bag2 green))
(print-solution m)

Chapter 3 - Estimation

Dice Problem

solution, example

(setf hypos '(4 6 8 12 20))
(setf d (make-instance 'dice :hypos hypos))
(mapcar #'(lambda (v)
            (update d v))
        '(6 8 7 7 5 4))
(print-solution d)

Locomotive Problem

solution, example

(defun iota-rec (lst val lower-limit)
  (if (>= val lower-limit)
    (iota-rec (push val lst) (1- val) lower-limit)
    lst))

(defun iota (upper-limit &optional (start 0))
  (iota-rec nil (+ (1- upper-limit) start) start))

(setf upper-bound '(500 1000 2000))
(setf alpha 1)

(mapcar #'(lambda (upper) (progn
                            (setf hypos (iota upper 1))
                            (setf tr (make-instance 'train
                                                    :hypos hypos
                                                    :alpha alpha))
                            
                            (setf observations '(30 60 90))
                            (mapcar #'(lambda (v) (update tr v)) observations)
                            (print (mean tr))))
        upper-bound)