123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213 |
- ;; Paper sheets of standard size: an expected value problem
- ;; TODO: rewrite to make sense of batches. for instance, if we run out of paper before the last batch, then we should count the last paper as a hit.
- ;; TODO: how should this problem be written? I want to keep track of the cache outside of the functions so I can add it in later, but this leads to a lot of ugly code... (a lot of passing around the cache
- (use-modules (srfi srfi-1))
- (use-modules (ice-9 receive))
- (define (solve)
- (expected-value (sheet-problem 15 5)))
- (define (expected-value soln-set)
- (display soln-set)
- (if (not (zero? (cadr soln-set)))
- (exact->inexact (/ (car soln-set) (cadr soln-set)))
- 0))
- (define (sheet-problem total-batches number-of-cuts)
- (define cache '())
- (define (can-use-sheet? sheet)
- (= sheet number-of-cuts))
-
- (define (cut-sheet sheet)
- (cut-sheet-to-size sheet number-of-cuts))
-
- (define (last-batch? curr-batch)
- (= total-batches curr-batch))
-
- (define (batch-loop envelope curr-batch soltn-set)
- (cond
- ((or (last-batch? curr-batch)
- (empty? envelope))
- soltn-set)
- ;; Not sure if we need this condition now...
- ((only-one-sheet? envelope)
- (if (can-use-sheet? (get-sheet envelope))
- soltn-set
- (batch-loop (cut-sheet (get-sheet envelope))
- (1+ curr-batch)
- (add-hit soltn-set)))); not sure if we add a hit here...
- (else (pick-sheets-loop envelope curr-batch (add-miss soltn-set)))))
- ;; TODO: consider not having an inner loop?
- ;; Does cache get remembered?
- (define (pick-sheets-loop envelope curr-batch soltn-set)
- (define (get-sub-soltn-set sheet rest-of-envelope)
- (let* ((n-envelope
- (if (can-use-sheet? sheet) rest-of-envelope
- (append (cut-sheet sheet) rest-of-envelope)))
- (key (envelope->key n-envelope)))
- (if (assoc key cache) (assoc-ref cache key)
- (begin
- (set! cache
- (acons key
- (batch-loop n-envelope (1+ curr-batch) '(0 0))
- cache))
- (assoc-ref cache key)))))
- (let pick-sheet-loop ((i 0) (curr-soltn-set soltn-set))
- (if (= i (sheets-in-envelope envelope)) curr-soltn-set
- (receive (sheet rest-of-envelope)
- (pick-sheet i envelope)
- (pick-sheet-loop (1+ i)
- (combine-soltn-sets
- curr-soltn-set
- (get-sub-soltn-set sheet rest-of-envelope)))))))
- (batch-loop (init-envelope number-of-cuts) 1 '(0 0)))
- (define (pick-sheet i envelope)
- (values (list-ref envelope i) (append (take envelope i) (drop envelope (1+ i)))))
- (define (init-envelope smallest-sheet-size)
- (cut-sheet-to-size 1 smallest-sheet-size))
- ;; TODO: not convinced by this name
- ;; TODO: see if there is a better way to express this...
- (define (cut-sheet-to-size sheet final-size)
- (if (= sheet final-size)
- (list sheet)
- (receive (half1 half2)
- (cut-sheet-in-half sheet)
- (cons half1 (cut-sheet-to-size half2 final-size)))))
- (define (cut-sheet-in-half sheet)
- (values (1+ sheet) (1+ sheet)))
- ; (display (cut-sheet-to-size 1 5))
- (define (only-one-sheet? envelope)
- (= 1 (length envelope)))
- (define (sheets-in-envelope envelope)
- (length envelope))
- (define (empty? envelope)
- (null? envelope))
- (define (get-sheet envelope)
- (car envelope))
- (define (get-sheets envelope)
- envelope)
- (define (add-hit soltn-set)
- (map 1+ soltn-set))
- (define (add-miss soltn-set)
- (list (car soltn-set)
- (1+ (cadr soltn-set))))
- (define (envelope->key envelope)
- (fold string-append "" (map number->string (sort envelope <))))
- ;(display (envelope->key '(2 1 3)))
- (define (combine-soltn-sets set1 set2)
- (map + set1 set2))
- ;(display (combine-soltn-sets '(1 2) '(2 2)))
- (display (solve))
- ;; Thise examples show how we can't rely on passing the cache in as a parameter since it is always pass by value
- (define (cache-test1)
- (define (outer-loop cache)
- (set! cache (acons "hi" (inner-loop cache) cache))
- (display cache)
- 0)
- (define (inner-loop cache)
- (set! cache (acons "there" "answer2" cache))
- cache)
- (outer-loop '()))
- ;; (cache-test1)
- (define (cache-test2)
- (define (outer-loop cache)
- (begin
- (inner-loop cache)
- (display cache)
- 0))
- (define (inner-loop cache)
- (set! cache (acons "there" "answer2" cache))
- cache)
- (outer-loop '()))
- ;; (cache-test2)
- ;;Okay seriously wtffff
- (define (cache-test3)
- (define (outer-loop cache)
- (let ((n-value (inner-loop cache))) ; lets hope one of the side effect is that the cache has changeddddddddd
- (newline)
- (display "cache after n-value")
- (display cache)
- (newline)
- (set! cache (acons "hi" n-value cache))
- (newline)
- (display "cache after set")
- (display cache)
- (newline)0))
- (define (inner-loop cache)
- (set! cache (acons "there" "answer2" cache))
- cache)
- (outer-loop '()))
- ;; (cache-test3)
- (define (cache-test4)
- (letrec* ((cache '())
- (outer-loop
- (lambda ()
- (newline)
- (display "cache after n-value")
- (display cache)
- (newline)
- (set! cache (acons "hi" (inner-loop) cache))
- (newline)
- (display "cache after set")
- (display cache)
- (newline)0))
- (inner-loop
- (lambda ()
- (set! cache (acons "there" "answer2" cache))
- "answer1")))
- (outer-loop)))
- ;; (cache-test4)
- (define (cache-test5)
- (let ((cache '()))
- (define (outer-loop)
- (begin
- (set! cache (acons "hi" (inner-loop) cache))
- (display cache)
- 0))
- (define (inner-loop)
- (set! cache (acons "there" "answer2" cache))
- "answer1")
- (outer-loop)))
- ;;(newline)
- ;;(cache-test5)
- ;; HUH, this is really sutble stuff!!!
|