codepad
[
create a new paste
]
login

about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; 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 (listadd xs n) (map (lambda (x) (+ n x)) xs)) (define (mergenodups 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 (exactsubsetsum xs t) (let loop ((xs xs) (ls (list 0))) (if (null? xs) (apply max ls) (loop (cdr xs) (filter (lambda (x) (<= x t)) (mergenodups ls (listadd ls (car xs)))))))) (display (exactsubsetsum '(1 4 5) 10)) (newline) (display (exactsubsetsum '(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 (approxsubsetsum 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 (mergenodups ls (listadd ls (car xs))) (/ e 2 len)))))))) (display (approxsubsetsum '(101 102 104 201) 308 0.4)) (newline) (display (approxsubsetsum '(101 102 104 201) 308 0.1)) (newline) (display (exactsubsetsum '(101 102 104 201) 308)) (newline)
Private
[
?
]
Run code
Submit