From bed2a6e69e095eadca4ff6d0e2f8a9b2e71e3956 Mon Sep 17 00:00:00 2001
From: Masaya Tojo <masaya@tojo.tokyo>
Date: Sun, 25 Aug 2024 18:23:48 +0900
Subject: Add `(accel-asc n vector->)` procedure

---
 integer-partition/accel-asc.scm | 59 +++++++++++++++++++++--------------------
 1 file changed, 30 insertions(+), 29 deletions(-)

(limited to 'integer-partition')

diff --git a/integer-partition/accel-asc.scm b/integer-partition/accel-asc.scm
index fcb21b2..e8982c2 100644
--- a/integer-partition/accel-asc.scm
+++ b/integer-partition/accel-asc.scm
@@ -14,7 +14,8 @@
 
 (define-library (integer-partition accel-asc)
   (export accel-asc)
-  (import (scheme base))
+  (import (scheme base)
+          (scheme case-lambda))
   (cond-expand
     ((library (scheme generator))
      (import (only (scheme generator) make-coroutine-generator)))
@@ -34,31 +35,31 @@
   (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 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)))))))))
-    ))
+    (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)))))))))))))
-- 
cgit v1.2.3