From bb786bb8167b19d9cd99892ccbfdc1e5a82f09b0 Mon Sep 17 00:00:00 2001
From: Linus <bjornstam.linus@fastmail.se>
Date: Wed, 9 Dec 2020 21:21:56 +0100
Subject: [PATCH] Added skip-wheels.

---
 example.scm           | 29 +++++++++++++++++++----
 wheel-utils/wheel.scm | 55 +++++++++++++++++++++++++------------------
 2 files changed, 56 insertions(+), 28 deletions(-)

diff --git a/example.scm b/example.scm
index 3b6b2c1..75dc24b 100644
--- a/example.scm
+++ b/example.scm
@@ -18,11 +18,6 @@
 ;; Then we make our wheel circular so that we don't have to check any null.
 (define actual-wheel (apply circular-list proto-wheel))
 
-;; Here we loop from 1 to 99 and print every "opening" in the wheel
-;; This _should_ be quite a lot faster than a solution that uses
-;; division, and it should be quite extensible. We could easily add
-;; a baz every 7 numbers.
-
 (define (wheel-fizzbuzz n)
   (let loop ((i 1) (wheel actual-wheel))
     (if (> i n)
@@ -41,3 +36,27 @@
       (cons "buzz" (loop (+ i 1))))
      (else
       (cons i (loop (+ i 1)))))))
+
+
+;;; Example: prime wheel
+;; Here we create a skip wheel that we can use to skip multiples of 2 3 5 and 7.
+;; It can be used when implementing, say, the sieve of erathostenes to skip numbers
+;; that are already known to be divisors of primes. Removing the first 4 prime-multiples
+;; drastically reduces the work that the program needs to do. The first false-positive
+;; given by the prime wheel is 11² (121), making this an extremely efficient way to
+;; reduce work when trying to find primes.
+(define prime-wheel
+  (apply circular-list
+         (skip-wheel
+          (every-n-in 2)
+          (every-n-in 3)
+          (every-n-in 5)
+          (every-n-in 7))))
+
+(display prime-wheel)
+
+(cons* 2 3 5 7 (let loop ((n 11) (wheel (drop prime-wheel 1)))
+                 (if (> n 200)
+                     '()
+                     (cons n (loop (+ n (car wheel)) (cdr wheel))))))
+           
diff --git a/wheel-utils/wheel.scm b/wheel-utils/wheel.scm
index 9ab57a2..373d84b 100644
--- a/wheel-utils/wheel.scm
+++ b/wheel-utils/wheel.scm
@@ -12,45 +12,54 @@
 ;; and that it should generate "steps" to take to jump over multiples of said
 ;; primes. It doesn't do that right now.
 
-
 (define-module (wheel-utils wheel)
-  #:use-module ((srfi srfi-1) #:select (every))
-  #:export (every-n-in generate-wheel))
-(define (next lsts)
-  (map (lambda (x) (if (null? (cddr x))
-		       (cons (car x) (car x))
-		       (cons (car x) (cddr x))))
-       lsts))
+  #:use-module ((srfi srfi-1) #:select (any every))
+  #:export (every-n-in generate-wheel skip-wheel))
 
-(define (stop? lsts)
-  (every (lambda (x) (null? (cddr x))) lsts))
 
 (define every-n-in
   (case-lambda
+    ((n) (every-n-in #t n n))
     ((val n)
      (every-n-in val n n))
     ((val pos out-of)
      (let loop ((i 1))
        (cond
-	((= i (+ out-of 1))
-	 '())
-	((= i pos)
-	 (cons val (loop (+ i 1))))
-	(else
-	 (cons #f (loop (+ i 1)))))))
+    ((= i (+ out-of 1))
+     '())
+    ((= i pos)
+     (cons val (loop (+ i 1))))
+    (else
+     (cons #f (loop (+ i 1)))))))
     ((val n i . pos)
      (error "not implemented yet"))))
-
-
-(define (generate-wheel combine . lsts)	
+ 
+ 
+(define (generate-wheel combine . lsts)
+  (define (stop? lsts)
+    (every (lambda (x) (null? (cddr x))) lsts))
+  (define (next lsts)
+    (map (lambda (x)
+           (if (null? (cddr x))
+               (cons (car x) (car x))
+               (cons (car x) (cddr x))))
+         lsts))
   ;; We need to keep track of the starting point of the lists
   ;; so we store them in a pair of (start . current-pos)
   (let loop ((lsts (map (lambda (x) (cons x x)) lsts)))
     (cons
      (apply combine (map cadr lsts))
      (if (stop? lsts)
-	 '()
-	 (loop (next lsts))))))
-
-
+     '()
+     (loop (next lsts))))))
 
+(define (skip-wheel . lsts)
+  (define (combine . vals)
+    (any values vals))
+  (define proto-wheel
+    (map not (apply generate-wheel combine lsts)))
+  (cdr (let loop ((lst proto-wheel) (steps 1))
+         (cond
+          ((null? lst) (list steps))
+          ((car lst) (cons steps (loop (cdr lst) 1)))
+          (else (loop (cdr lst) (+ steps 1)))))))