[PRL] Accumulator for container capacity

[Matthias Felleisen]

Mitch's and Will's solutions are better than mine (and I hadn't even 
thought of it). They do require a lot of packing and unpacking of 
structures. I tend to forget that optimizing compilers do away with 
this code anyway and I shouldn't worry about it.

Mea culpa for using a set! and imaging I needed store-passing.

-- Matthias



On Sep 23, 2005, at 1:05 PM, William D Clinger wrote:

> Here is a version of the code that uses the purely functional
> Visitor pattern.  If you don't like the use of foldr inside
> the check procedure, you can define make-Container-FoldR in
> the obvious way and make the obvious changes to check.
>
> Will
>
> --------
>
> ;(module container mzscheme
>
>   (define-struct Container (contents capacity))
>   (define-struct Simple (name weight))
>
>   ;; --- MF added ---
>   ;; A Container is (make-Container (Listof Item) Number).
>   ;;
>   ;; An Item is one of:
>   ;;  -- (make-Simple Symbol Number)
>   ;;  -- Container
>   ;; --- end added ---
>
>   ;; --- WDC added ---
>   ;;
>   ;; A Container-Visitor: Container -> T is
>   ;;     (make-Container-Visitor simple-visitor container-visitor)
>   ;; where
>   ;; simple-visitor: Symbol x Number -> T
>   ;; container-visitor: (Listof T) x Number -> T
>
>   (define (make-Container-Visitor simple-visitor container-visitor)
>     (define (visitor c)
>       (cond ((Simple? c)
>              (simple-visitor (Simple-name c) (Simple-weight c)))
>             ((Container? c)
>              (container-visitor (map visitor (Container-contents c))
>                                 (Container-capacity c)))
>             (else ???)))
>     visitor)
>
>   ;; --- end added ---
>
>   ;; Test object c1 in Scheme
>
>   ;; --- MF changed ---
>   (define c-1
>     (make-Container (list (make-Simple "apple" 1))
>       1))
>
>   (define c0
>     (make-Container (list (make-Simple "pencil" 1)
>                       c-1
>                       (make-Simple "orange" 1))
>       1))
>
>   (define c1
>     (make-Container (list (make-Simple "apple" 1)
>                       c0
>                       (make-Simple "orange" 1)
>                       (make-Simple "kiwi" 1))
>       5))
>   ;; --- end changed ---
>
>   ;; -- mw changed --
>
>   (define-struct wv (weight violations))
>
>   (define (foldr f seed l)
>     (if (null? l) seed
>       (f (car l) (foldr f seed (cdr l)))))
>
>
>   ;; check returns the total number of capacity violations in a 
> container
>   ;; check: Container -> int
>
>   ;; --- WDC changed ---
>
>   (define (check ac)
>     (wv-violations
>      ((make-Container-Visitor
>        (lambda (name weight) (make-wv weight 0))
>        (lambda (wvs capacity)
>          (let* ((totals
>                  (foldr (lambda (wv1 wv2)
>                           (make-wv
>                            (+ (wv-weight wv1) (wv-weight wv2))
>                            (+ (wv-violations wv1) (wv-violations 
> wv2))))
>                         (make-wv 0 0)
>                         wvs))
>                 (total-weight (wv-weight totals))
>                 (total-violations (wv-violations totals)))
>            (make-wv total-weight
>                     (if (> total-weight capacity)
>                         (+ 1 total-violations)
>                         total-violations)))))
>       ac)))
>
>   ;; --- end changed ---
>
> ;  )
>
> _______________________________________________
> PRL mailing list
> PRL at lists.ccs.neu.edu
> https://lists.ccs.neu.edu/bin/listinfo/prl