Added skip-wheels.
This commit is contained in:
parent
082082fcb9
commit
bb786bb816
2 changed files with 56 additions and 28 deletions
29
example.scm
29
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))))))
|
||||
|
||||
|
|
|
@ -12,21 +12,14 @@
|
|||
;; 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)
|
||||
|
@ -43,6 +36,14 @@
|
|||
|
||||
|
||||
(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)))
|
||||
|
@ -52,5 +53,13 @@
|
|||
'()
|
||||
(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)))))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue