codepad

Language:

; knapsack

(define (make-matrix rows columns . value)
  (do ((m (make-vector rows)) (i 0 (+ i 1)))
      ((= i rows) m)
    (if (null? value)
        (vector-set! m i (make-vector columns))
        (vector-set! m i (make-vector columns (car value))))))

(define (matrix-rows x) (vector-length x))

(define (matrix-cols x) (vector-length (vector-ref x 0)))

(define (matrix-ref m i j) (vector-ref (vector-ref m i) j))

(define (matrix-set! m i j x) (vector-set! (vector-ref m i) j x))

(define (knapsack objs cap) ; objs is vector of #(name value weight)
  (let* ((len (vector-length objs))
         (vs (make-matrix (+ len 1) (+ cap 1) 0))
         (ns (make-matrix (+ len 1) (+ cap 1) #f)))

(define (n i) (vector-ref (vector-ref objs (- i 1)) 0))
    (define (v i) (vector-ref (vector-ref objs (- i 1)) 1))
    (define (w i) (vector-ref (vector-ref objs (- i 1)) 2))
    (define (mv r c) (matrix-ref vs r c))
    (define (mn r c) (matrix-ref ns r c))
    (define (mv! r c x) (matrix-set! vs r c x))
    (define (mn! r c x) (matrix-set! ns r c x))

; (do ((c 0 (+ c 1))) ((< len c)) (mv! 0 c 0))

(do ((r 1 (+ r 1))) ((< len r))
      (do ((c 0 (+ c 1))) ((< cap c))
        (cond ((and (<= (w r) c)
                    (< (mv (- r 1) c)
                       (+ (v r) (mv (- r 1) (- c (w r))))))
                (mv! r c (+ (v r) (mv (- r 1) (- c (w r)))))
                (mn! r c #t))
              (else (mv! r c (mv (- r 1) c)) (mn! r c #f)))))

(let loop ((r len) (k cap) (ks '()))
      (cond ((zero? r) (values (mv len cap) ks))
            ((mn r k) (loop (- r 1) (- k (w r)) (cons (n r) ks)))
            (else (loop (- r 1) k ks))))))

(call-with-values
  (lambda () (knapsack #(#(a 10 5) #(b 40 4) #(c 30 6) #(d 50 3)) 10))
  (lambda (x xs) (display x) (display " ") (display xs) (newline)))

(call-with-values
  (lambda () (knapsack #(#(a 4 12) #(b 2 1) #(c 10 4) #(d 2 2) #(e 1 1)) 15))
  (lambda (x xs) (display x) (display " ") (display xs) (newline)))

Private [?]

Run code