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)

terça-feira, 7 de dezembro de 2010

Functional Round-Robin scheduler in Common Lisp



A while ago I posted a robin-round tournament scheduler in ruby. Since I am going
through PAIP, I thought to give a functional common lisp version a go.



In my opinion it is more readable and flexible, but I would
attribute that to better design and experience than the
language. But CL's list utilities sure helped.


;;;; round-robin.lisp

(defpackage :round-robin
  (:use :cl :lisp-unit))

(in-package :round-robin)

;; rotate-list-left : (listof X) integer -> (listof X)
(defun rotate-list-left (a-list how-many-moves)
  "rotate the list how-many-moves to the left"
  (if (zerop how-many-moves)
      a-list
      (rotate-list-left (append (rest a-list)
                                (list (first a-list)))
                        (1- how-many-moves))))

;; make-matches : (listof X) -> (listof X)
(defun make-matches (players)
  (if (null players)
      nil
      (cons (cons (first players)
                  (last players))
            (make-matches (butlast (rest players))))))

;; print-matches : (listof (listof X)) -> nil
(defun print-matches (matches)
  (if (null matches)
      nil
      (progn
        (let ((current-match (first matches)))
          (print (format nil "~a against ~a!"
                         (first current-match)
                         (second current-match))))
        (print-matches (rest matches)))))



;; round-robin : (listof X) -> nil
(defun round-robin (players)
  "prints matches in round robin fashion"
  (defun do-matches (full-list-of-players
                     max-number-of-rounds
                     current-round)
    (if (>= current-round max-number-of-rounds)
        nil
        (progn (print-matches
                (make-matches
                 (cons (first full-list-of-players)
                       (rotate-list-left (rest full-list-of-players)
                                         current-round))))
               (do-matches full-list-of-players
                 max-number-of-rounds
                 (1+ current-round)))))
  (let ((full-list (if (zerop (mod (length players) 2))
                       players
                       (append players (list 'DUMMY)))))
    (do-matches full-list (length full-list) 1)))

(define-test round-robin-utilities
  (print-matches '((a f) (b e) (c d))) ;; check output
  (assert-equal (rotate-list-left '(a b c d e f g h) 3)
                '(d e f g h a b c))
  (assert-equal (make-matches '(a b c d e f))
                '((a f) (b e) (c d))))

(define-test round-robin
  (print "Even number of players")
  (round-robin '(a b c d))

  (print "Odd number of players")
  (round-robin '(a b c d e)))

(run-tests)



quinta-feira, 2 de dezembro de 2010

A small view on the history of programming and personal computing

I have just finished a draft of an article that I wanted to write for some time:

A small view on the history of programming and personal computing

Here is a copy of the abstract:

Those who cannot remember the past are condemned to repeat it.
Because programmers usually think they deal with cutting edge tech-
nology, they tend to forget the age and genealogy of the ideas they
are working with. A demonstration of the history of the some crucial
ideas of the programming craft would avoid the repetition of error and
allow better ideas to take hold.

Suggestions and feedback are more than welcome.