diff options
Diffstat (limited to 'integer-partition/accel-asc.scm')
-rw-r--r-- | integer-partition/accel-asc.scm | 61 |
1 files changed, 29 insertions, 32 deletions
diff --git a/integer-partition/accel-asc.scm b/integer-partition/accel-asc.scm index e8982c2..870cb0b 100644 --- a/integer-partition/accel-asc.scm +++ b/integer-partition/accel-asc.scm @@ -14,8 +14,7 @@ (define-library (integer-partition accel-asc) (export accel-asc) - (import (scheme base) - (scheme case-lambda)) + (import (scheme base)) (cond-expand ((library (scheme generator)) (import (only (scheme generator) make-coroutine-generator))) @@ -33,33 +32,31 @@ (loop)) (if #f #f))))))) (begin - ;; This is a Scheme implementation of Jerome Kelleher's algorithm for generating integer paritions. - ;; See: https://jeromekelleher.net/category/combinatorics.html - (define accel-asc - (case-lambda - ((n) - (accel-asc n vector-copy)) - ((n vector->) - (make-coroutine-generator - (lambda (yield) - (let ((a (make-vector (+ n 1) 0)) - (k 1) - (x 0) - (y (- n 1))) - (while (not (= k 0)) - (set! x (+ (vector-ref a (- k 1)) 1)) - (set! k (- k 1)) - (while (<= (* 2 x) y) - (vector-set! a k x) - (set! y (- y x)) - (set! k (+ k 1))) - (let ((l (+ k 1))) - (while (<= x y) - (vector-set! a k x) - (vector-set! a l y) - (yield (vector-> a 0 (+ k 2))) - (set! x (+ x 1)) - (set! y (- y 1))) - (vector-set! a k (+ x y)) - (set! y (+ x y -1)) - (yield (vector-> a 0 (+ k 1))))))))))))) + (define (accel-asc n) + (accel-asc* n vector-copy)) + + (define (accel-asc* n convert) + (make-coroutine-generator + (lambda (yield) + (let ((a (make-vector (+ n 1) 0)) + (k 1) + (x 0) + (y (- n 1))) + (while (not (= k 0)) + (set! x (+ (vector-ref a (- k 1)) 1)) + (set! k (- k 1)) + (while (<= (* 2 x) y) + (vector-set! a k x) + (set! y (- y x)) + (set! k (+ k 1))) + (let ((l (+ k 1))) + (while (<= x y) + (vector-set! a k x) + (vector-set! a l y) + (yield (convert a 0 (+ k 2))) + (set! x (+ x 1)) + (set! y (- y 1))) + (vector-set! a k (+ x y)) + (set! y (+ x y -1)) + (yield (convert a 0 (+ k 1))))))))) + )) |