[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/14Q1hJvZ    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Jun 15:
; 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)))


Output:
1
2
3
4
108
7427466391
136
5966290435


Create a new paste based on this one


Comments: