; subset sum clrs 35.5, part 2

(define (filter pred? xs)
  (let loop ((xs xs) (ys '()))
    (cond ((null? xs) (reverse ys))
          ((pred? (car xs))
            (loop (cdr xs) (cons (car xs) ys)))
          (else (loop (cdr xs) ys)))))

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

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

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

(call-with-values
  (lambda () (exact-subset-sum '(1 4 5) 10))
  (lambda (sum subset)
    (display sum) (display " ") (display subset) (newline)))
(call-with-values
  (lambda () (exact-subset-sum '(1 4 5) 8))
  (lambda (sum subset)
    (display sum) (display " ") (display subset) (newline)))

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

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

(call-with-values
  (lambda () (approx-subset-sum '(101 102 104 201) 308 0.4))
  (lambda (sum subset)
    (display sum) (display " ") (display subset) (newline)))
(call-with-values
  (lambda () (approx-subset-sum '(101 102 104 201) 308 0.1))
  (lambda (sum subset)
    (display sum) (display " ") (display subset) (newline)))

10 (1 4 5)
6 (1 5)
302 (101 201)
307 (101 102 104)