; billboard challenge, part 2
(define (prime? n)
(if (even? n) #f
(let loop ((f 3))
(if (< n (* f f)) #t
(if (zero? (modulo n f)) #f
(loop (+ f 2)))))))
(define (sum xs) (apply + xs))
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
(if (zero? n) d
(loop (quotient n b)
(cons (modulo n b) d))))))
(define (make-list n x)
(let loop ((n n) (xs '()))
(if (zero? n) xs
(loop (- n 1) (cons x xs)))))
(define-syntax define-generator
(lambda (x)
(syntax-case x (lambda)
((stx name (lambda formals e0 e1 ...))
(with-syntax ((yield (datum->syntax-object (syntax stx) 'yield)))
(syntax (define name
(lambda formals
(let ((resume #f) (return #f))
(define yield
(lambda args
(call-with-current-continuation
(lambda (cont)
(set! resume cont)
(apply return args)))))
(lambda ()
(call-with-current-continuation
(lambda (cont)
(set! return cont)
(cond (resume (resume))
(else (let () e0 e1 ...)
(error 'name "unexpected return"))))))))))))
((stx (name . formals) e0 e1 ...)
(syntax (stx name (lambda formals e0 e1 ...)))))))
(define-generator (make-spigot f lo hi)
(define (split v)
(values (vector-ref v 0) (vector-ref v 1) (vector-ref v 2)))
(define (approx abc n)
(let-values (((a b c) (split abc)))
(quotient (+ (* a n) b) c)))
(define (mul abc def)
(let-values (((a b c) (split abc)) ((d e f) (split def)))
(vector (* a d) (+ (* a e) (* b f)) (* c f))))
(define (g k) (let-values (((n d a) (f k))) (vector n (* a d) d)))
(let loop ((z (vector 1 0 1)) (k 1))
(let ((lbound (approx z lo)))
(cond ((= lbound (approx z hi))
(yield lbound)
(loop (mul (vector 10 (* -10 lbound) 1) z) k))
(else (loop (mul z (g k)) (+ k 1)))))))
(define e-spigot (make-spigot (lambda (k) (values 1 k 1)) 1 2))
(define (billboard1)
(let loop ((i 0) (n (e-spigot)))
(if (and (< #e1e9 n) (prime? n)) (values i n)
(loop (+ i 1) (+ (* 10 (modulo n #e1e9)) (e-spigot))))))
(call-with-values
(lambda () (billboard1))
(lambda (start-position ten-digits)
(display start-position) (newline)
(display ten-digits) (newline)))
(define e-spigot (make-spigot (lambda (k) (values 1 k 1)) 1 2))
(define (billboard2 k)
(let loop ((k k) (i 0) (n (e-spigot)))
(if (and (< #e1e9 n) (= (sum (digits n)) 49))
(if (= k 1)
(values i n)
(loop (- k 1) (+ i 1)
(+ (* 10 (modulo n #e1e9)) (e-spigot))))
(loop k (+ i 1) (+ (* 10 (modulo n #e1e9)) (e-spigot))))))
(call-with-values
(lambda () (billboard2 5))
(lambda (start-position ten-digits)
(display start-position) (newline)
(display ten-digits) (newline)))