Programming Praxis

The only data structure we need is a list; whenever the original algorithm keeps a partial sum, we keep a list with the partial sum in the car and the set members that make up the partial sum, in descending order, in the cdr. For instance, the list ‘(307 104 102 101) encodes the partial sum 307 = 104 + 102 + 101. Here is the modified list-add; we changed variable name xs, which is a list of x, to xss, which is a list of lists of x:

(define (list-add xss n)
  (map (lambda (xs) (cons (+ n (car xs)) (cons n (cdr xs)))) xss))

The changes to merge-no-dups are also simple; again, we change the variable name, and the comparison also changes, to extract the partial sum from the car of the sublist:

(define (merge-no-dups xss yss)
  (let loop ((xss xss) (yss yss) (zss (list)))
    (cond ((and (null? xss) (null? yss)) (reverse zss))
          ((null? xss) (loop xss (cdr yss) (cons (car yss) zss)))
          ((null? yss) (loop (cdr xss) yss (cons (car xss) zss)))
          ((< (caar xss) (caar yss)) (loop (cdr xss) yss (cons (car xss) zss)))
          ((< (caar yss) (caar xss)) (loop xss (cdr yss) (cons (car yss) zss)))
          (else (loop (cdr xss) (cdr yss) (cons (car xss) zss))))))

Now for the exact algorithm. It’s easy, as long as you keep the types in mind; notice that apply max becomes a loop to search for the maximum partial sum:

(define (exact-subset-sum xs t)
  (let loop ((xs xs) (lss (list (list 0))))
    (if (null? xs)
    (let loop ((lss (cdr lss)) (ms (car lss)))
          (if (null? lss)
              (values (car ms) (reverse (cdr ms)))
              (if (< (car ms) (caar lss))
                     (loop (cdr lss) (car lss))
                     (loop (cdr lss) ms))))
        (loop (cdr xs)
              (filter (lambda (ls) (<= (car ls) t))
                (merge-no-dups lss (list-add lss (car xs))))))))

Again, the trim function changes only to accomodate the new data type:

(define (trim xss d)
  (let loop ((last (car xss)) (xss (cdr xss)) (lss (list (car xss))))
    (if (null? xss) (reverse lss)
      (if (< (* (car last) (+ 1 d)) (caar xss))
          (loop (car xss) (cdr xss) (cons (car xss) lss))
          (loop last (cdr xss) lss)))))

Then the approximate algorithm is the same as the exact algorithm with the addition of the trim function:

(define (approx-subset-sum xs t e)
  (let ((len (length xs)))
    (let loop ((xs xs) (lss (list (list 0))))
      (if (null? xs)
          (let loop ((lss (cdr lss)) (ms (car lss)))
            (if (null? lss)
                (values (car ms) (reverse (cdr ms)))
                (if (< (car ms) (caar lss))
                    (loop (cdr lss) (car lss))
                    (loop (cdr lss) ms))))
          (loop (cdr xs)
                (filter (lambda (ls) (<= (car ls) t))
                  (trim (merge-no-dups lss (list-add lss (car xs)))
                        (/ e 2 len))))))))

You can run the program at http://programmingpraxis.codepad.org/2QfXBlnw.

Pages: 1 2