Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SECTION ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Macros
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Unicode is the future
(define-macro (λ . args)
`(lambda ,@args))
(define-macro (cons-lazy a b)
`(cons ,a (delay ,b)))
;; Imperative lazy foreach (only allows a single variable, not multiple like
;; Racket's)
(define-macro (for-lazy var . rest)
(let ([name (car var)]
[list-expr (cadr var)])
`(let ([--list-- ,list-expr])
(let --loop-- ([--list-- --list--])
(if (null? --list--)
(void)
(let ([,name (car --list--)])
,@rest
(--loop-- (cdr-lazy --list--))))))))
(define-macro (list* first . rest)
(if (null? rest)
first
`(cons ,first (list* ,@rest))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SECTION ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functional programming helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (curry f . curried-args)
(lambda args (apply f (append curried-args args))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SECTION ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Lazy helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (cdr-lazy lst) (force (cdr lst)))
(define (foldl-lazy f default lst)
(if (null? lst)
default
(let ([fst (car lst)]
[snd (cdr-lazy lst)])
(f fst (foldl-lazy f default snd)))))
(define (map-lazy f lst)
(if (null? lst)
'()
(let ([fst (car lst)]
[snd (cdr-lazy lst)])
(cons-lazy (f fst) (map-lazy f snd)))))
(define (filter-lazy pred? lst)
(if (null? lst)
'()
(let ([fst (car lst)]
[snd (cdr-lazy lst)])
(if (pred? fst)
(cons-lazy fst (filter-lazy pred? snd))
(filter-lazy pred? snd)))))
(define (range-lazy lo hi)
(range-step-lazy lo hi (if (< lo hi) 1 -1)))
(define (range-step-lazy lo hi step)
(let ([op (if (< step 0) <= >=)])
(range-step-op-lazy lo hi step op)))
(define (range-step-op-lazy lo hi step op)
(if (op lo hi)
'()
(cons-lazy
lo
(range-step-op-lazy (+ lo step)
hi
step
op))))
(define (append-lazy fst . lsts)
(if (null? lsts)
fst
(if (null? fst)
(apply append-lazy lsts)
(cons-lazy (car fst)
(apply append-lazy
(force (cdr fst))
lsts)))))
(define (cross-product-lazy fst snd)
(define (inner lst elem)
(map-lazy (curry list elem)
lst))
(apply-append-lazy (map-lazy (curry inner snd)
fst)))
(define (take-while-lazy pred? lst)
(if (null? lst)
lst
(let ([fst (car lst)]
[snd (cdr-lazy lst)])
(if (pred? fst)
(cons-lazy fst (take-while-lazy pred? snd))
'()))))
(define (apply-append-lazy lsts)
(let ([fst (car lsts)]
[rest (cdr-lazy lsts)])
(if (null? rest)
fst
(if (null? fst)
(apply-append-lazy rest)
(cons-lazy (car fst)
(apply-append-lazy
(cons-lazy (cdr-lazy fst)
rest)))))))
(define (skip-while-lazy pred? lst)
(if (null? lst)
lst
(if (pred? (car lst))
(skip-while-lazy pred? (cdr-lazy lst))
lst)))
(define (list->lazy-list lst)
(if (null? lst)
'()
(cons-lazy (car lst) (list->lazy-list (cdr lst)))))
(define (lazy-list->list lst)
(foldl-lazy cons '() lst))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SECTION ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Sieve of Atkin-related helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (solutions-4x^2+y^2 limit)
(define search-space
(cross-product-lazy (range-lazy 1 ; All x's
(sqrt (/ (- limit 1) 4)))
(range-step-lazy 1 ; Odd y's
(sqrt (- limit 4))
2)))
(filter-lazy
(curry >= limit)
(map-lazy
(curry apply
(λ (x y) (+ (* 4 (square x))
(square y))))
search-space)))
(define (solutions-3x^2+y^2 limit)
(define search-space
(cross-product-lazy (range-step-lazy 1 ; Odd x's
(sqrt (/ (- limit 1) 3))
2)
(range-step-lazy 2 ; Even y's
(sqrt (- limit 3))
2)))
(filter-lazy
(curry >= limit)
(map-lazy
(curry apply
(λ (x y) (+ (* 3 (square x))
(square y))))
search-space)))
(define (solutions-3x^2-y^2 limit)
;; Solves quadratic 3x² - (x - 1)² = limit (i.e. the x value that gives the
;; maximum possible value of 3x² - y²)
(define max-x (/ (- (sqrt (- (* 2 limit) 1)) 1) 2))
(define search-space
(apply-append-lazy
(map-lazy (λ (x)
(map-lazy (curry list x)
(range-step-lazy (- x 1) 0 -2)))
(range-lazy 2 max-x))))
(filter-lazy
(curry >= limit)
(map-lazy
(curry apply
(λ (x y) (- (* 3 (square x))
(square y))))
search-space)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SECTION ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Sieve of Atkin, see https://en.wikipedia.org/wiki/Sieve_of_Atkin
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (primes-below n)
;; For performance reasons we use constant-time indexable `vector' instead of
;; list, and set it mutably instead of purely.
;; We waste space for 0, 1, 2, 3, etc. (which we will never need to check),
;; but it makes the implementation more readable.
(define possible-solutions (make-vector n #f))
(define is-prime? (curry vector-ref possible-solutions))
(define set-prime! (curry vector-set! possible-solutions))
(define (flip! n) (set-prime! n (not (is-prime? n))))
(define wheel-hits '(1 7 11 13 17 19 23 29 31 37 41 43 47 49 53 59))
(define check-nums
(take-while-lazy
(curry >= n)
(map-lazy
(λ (pair) (+ (* 60 (car pair))
(cadr pair)))
(cross-product-lazy
(range-lazy 0 (/ n 60))
(list->lazy-list wheel-hits)))))
(for-lazy [i (solutions-4x^2+y^2 n)]
(case (remainder i 60)
[(1 13 17 29 37 41 49 53)
(flip! i)]))
(for-lazy [i (solutions-3x^2+y^2 n)]
(case (remainder i 60)
[(7 19 31 43)
(flip! i)]))
(for-lazy [i (solutions-3x^2-y^2 n)]
(case (remainder i 60)
[(11 23 47 59)
(flip! i)]))
(for-lazy [i (filter-lazy
(λ (x)
(and (>= x 7)
(is-prime? x)))
check-nums)]
(define not-prime
(take-while-lazy (curry >= n)
(map-lazy (curry * i i)
check-nums)))
(for-lazy [j not-prime]
(set-prime! j #f)))
(list* 2 3 5
(lazy-list->list
(filter-lazy is-prime? (range-lazy 7 n)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment