## segunda-feira, 13 de dezembro de 2010

### How many fume cupboards are needed? -- Scheme version

I am going through Principles of Statistics in order to build a more respectable statistical knowledge. When I got to problem 2.6 I though it was computational heavy for such a lazy person such as I. Apparently I am not alone in that thinking.

The result is that I ended building a scheme version of the code
found in the above page. It was a very interesting exercise. You
can see the problem and the code below:

```#lang racket
;; In a certain survey of the work of chemical research workers, it was
;; found, on the basis of extensive data, that on average each man
;; required no fume cupboard for 60 per cent of his time, one cupboard
;; for 30 per cent and two cupboards for 10 per cent; three or more were
;; never required. If a group of four chemists worked independently of
;; one another, how many fume cupboards should be availabe in order to
;; provode adequate facilities for at least 95 per cent of the time?
(require "cartesian-product.rkt"
rackunit
rackunit/text-ui)

(define probability-of-cupboards
#hash((0 . 0.6)
(1 . 0.3)
(2 . 0.1)))

;; how-many-cupboards-for-% : integer number hash -> number
;; given a minimum % and a table of probabilities, find the number of
;; cupboards that will be adequated for the number of people given.
(define (how-many-cupboards-for-% number-of-people
minimum-%
table-of-probabilities)
(local [(define possibilities
(sort (hash-keys table-of-probabilities) <))
(define (accumulate-trials-probabilities
trials
accumulated-probabilities)
(if (empty? trials)
accumulated-probabilities
(accumulate-trials-probabilities
(rest trials)
(update-or-insert-probability
accumulated-probabilities
(foldl (λ (x y)
(+ x y))
0 (first trials))
(foldl (λ (trial-event probability-of-trial)
(* (hash-ref table-of-probabilities
trial-event)
probability-of-trial))
1.0 (first trials))))))]
(probability-table->result-with-%-greater-than
(accumulate-trials-probabilities
(cartesian-product (make-list number-of-people possibilities)) (hash))
minimum-%)))

;; probability-table->result-with-%-greater-than : hash number -> number or false
;; takes a probability table with the accumulated results, adds up then
;; in sequence until it surpasses the threshold. False if there is no it never
;; surpasses the threshold.
(define (probability-table->result-with-%-greater-than table minimum-%)
(define (accumulate-result list-of-possibilities
acc-probability
(last-probability #f))
(cond ((empty? list-of-possibilities)
(if (< acc-probability minimum-%) #f last-probability))
((> acc-probability minimum-%) last-probability)
(else (accumulate-result (rest list-of-possibilities)
(+ (hash-ref table
(first list-of-possibilities))
acc-probability)
(first list-of-possibilities)))))
(accumulate-result (sort (hash-keys table) <) 0))

;; update-or-insert-probability : hash integer number -> hash
(define (update-or-insert-probability table
cupboard-number
probability)
(hash-update table
cupboard-number
(λ (old-probability)
(+ old-probability probability))
0))

(define-test-suite cupboards
(check-equal? (how-many-cupboards-for-% 4 0.95 probability-of-cupboards) 4)

(check-equal? (probability-table->result-with-%-greater-than
#hash((0 . 0.1296)
(1 . 0.2592)
(2 . 0.2808)
(3 . 0.1944)
(4 . 0.094)
(5 . 0.0324)) 0.94)
4)
(check-equal? (probability-table->result-with-%-greater-than
#hash() 0.0)
#f)
(check-equal? (probability-table->result-with-%-greater-than
#hash((0 . 0.4)
(1 . 0.2)) 0.7)
#f))

(run-tests cupboards)
```