cperilla
10/22/2013 - 9:09 PM

This week programing praxis: http://programmingpraxis.com/2013/10/22/david-gries-coffee-can-problem/2/ If you want to see it running us

This week programing praxis: http://programmingpraxis.com/2013/10/22/david-gries-coffee-can-problem/2/

If you want to see it running use chicken scheme.

;; David Gries described today’s exercise in his 1981 book The Science
;; of Programming; I learned it from Jon Bentley’s 2000 book Programming
;; Pearls, second edition.

;;  You are initially given a coffee can that contains some black
;;  beans and some white beans and a large pile of “extra” black
;;  beans. You then repeat the following process until there is a
;;  single bean left in the can.

;;      Randomly select two beans from the can. If they are the same
;;      color, throw them both out and insert an extra black
;;      bean. If they are different colors, return the white bean to
;;      the can and throw out the black.

;;  Prove that the process terminates. What can you say about the
;;  color of the final remaining bean as a function of the numbers of
;;  black and white beans originally in the can?


;; My comments
;;
;; 1. It should terminate because all the operations reduce the total 
;; number of beans in the can
;;
;; 2. My initial guess is that the final color depends just on the odd/even
;; of the beans
;;
;; 3. It turns out that the white beans are removed by pairs, so the a
;; white bean remains if at the beggingin there's an odd number of
;; beans.
;;
;; 4. 


(define (bag size)
  (let* [(white (random size))
         (black (- size white))]
    (list white black)))

(define (bag-total bag)
  (+ (car bag) (cadr bag)))

(define (bag-pick-one bag)
  (if (< (random (bag-total bag)) (car bag))
      (list 'white (bag-discard-white bag))
      (list 'black (bag-discard-black bag)) ))

(define (bag-discard-white bag)
  (if (> (car bag) 0)
      (cons (- (car bag) 1) (cdr bag))
      bag))
(define (bag-discard-black bag)
  (if (> (cadr bag) 0)
      (list (car bag) (- (cadr bag) 1))
      bag))

(define (bag-insert-black bag)
  (list (car bag) (+ (cadr bag) 1)))
(define (bag-insert-white bag)
  (cons (+ (car bag) 1) (cdr bag)))

(define (bag-drop bag)
  (print bag)
  (if (> (bag-total bag) 1)
      (let* [(first (bag-pick-one bag))
             (second (bag-pick-one (cadr first)))
             (new-bag (cadr second))]
        (if (equal? (car first) (car second))
            (bag-drop (bag-insert-black new-bag))
            (bag-drop (bag-insert-white new-bag))))
      bag))

(bag-drop (bag 10))