[PRL] Accumulator for container capacity

[Mitchell Wand]

Karl wrote:

> Hi Mitch:
>
> your solution is violating the constraint of doing the traversal only 
> once.
>
> I think that Matthias wanted to avoid code like:
>
> (define (process-loi l)
>             (local ((define w (foldr + 0 (map tweight-item l)))
>                     (define v (foldr + 0 (map tviol-item l))))
>                                               (cons w v)))
>
No, what I said was:

>  Why not just do a single recursive descent of the tree, returning
>  (#of violations, weight of items) ? No accumulators, no state, not
>  even an inherited attribute.

That's not what Karl's code does.  Here's what I had in mind:

(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 ---

  ;; 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

  (define (check ac)
    ;; item -> (pair weight nviolations)
    (define (weight-and-violations-of-item it)
      (cond
        ((Simple? it) (make-wv (Simple-weight it) 0))
        ((Container? it)
         (weight-and-violations-of-container it))))
    ;; container -> (pair weight nviolations)
    (define (weight-and-violations-of-container ac)
      (let ((wvs
              (map weight-and-violations-of-item
                (Container-contents ac))))
        (let ((total-weight (foldr + 0 (map wv-weight wvs)))
              (total-viols  (foldr + 0 (map wv-violations wvs))))
          (make-wv
            total-weight
            (if (> total-weight (Container-capacity ac))
              (+ 1 total-viols)
              total-viols)))))
    (wv-violations (weight-and-violations-of-container ac)))

  )

-------------- next part --------------
HTML attachment scrubbed and removed