[ create a new paste ] login | about

Link: http://codepad.org/gcOgY3rQ    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on May 26:
; subset sums clrs 35.5

(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 xs n)
  (map (lambda (x) (+ n x)) xs))

(define (merge-no-dups xs ys)
  (let loop ((xs xs) (ys ys) (zs (list)))
    (cond ((and (null? xs) (null? ys)) (reverse zs))
          ((null? xs) (loop xs (cdr ys) (cons (car ys) zs)))
          ((null? ys) (loop (cdr xs) ys (cons (car xs) zs)))
          ((< (car xs) (car ys)) (loop (cdr xs) ys (cons (car xs) zs)))
          ((< (car ys) (car xs)) (loop xs (cdr ys) (cons (car ys) zs)))
          (else (loop (cdr xs) (cdr ys) (cons (car xs) zs))))))

(define (exact-subset-sum xs t)
  (let loop ((xs xs) (ls (list 0)))
    (if (null? xs) (apply max ls)
      (loop (cdr xs)
            (filter (lambda (x) (<= x t))
              (merge-no-dups ls (list-add ls (car xs))))))))

(display (exact-subset-sum '(1 4 5) 10)) (newline)
(display (exact-subset-sum '(1 4 5) 8)) (newline)

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

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

(display (approx-subset-sum '(101 102 104 201) 308 0.4)) (newline)
(display (approx-subset-sum '(101 102 104 201) 308 0.1)) (newline)
(display (exact-subset-sum '(101 102 104 201) 308)) (newline)


Output:
1
2
3
4
5
10
6
302
307
307


Create a new paste based on this one


Comments: