; miscellanea
; fizzbuzz
(define (divides? d n) (zero? (modulo n d)))
(define (fizz-buzz n)
(do ((i 1 (+ i 1))) ((< n i))
(cond ((divides? 15 i) (display "FizzBuzz"))
((divides? 5 i) (display "Buzz"))
((divides? 3 i) (display "Fizz"))
(else (display i)))
(newline)))
(fizz-buzz 20)
(define (fb-sum n)
(define (g n) (* 1/2 n (+ n 1)))
(define (f k) (* k (g (quotient n k))))
(+ (f 3) (f 5) (- (f 15))))
(do ((i 1 (+ i 1))) ((< 20 i))
(display (fb-sum (- (expt 10 i) 1)))
(newline))
; prime words
(define (expm b e m)
(define (m* x y) (modulo (* x y) m))
(cond ((zero? e) 1)
((even? e) (expm (m* b b) (/ e 2) m))
(else (m* b (expm (m* b b) (/ (- e 1) 2) m)))))
(define (strong-pseudo-prime? a n)
(let loop ((r 0) (s (- n 1)))
(if (even? s) (loop (+ r 1) (/ s 2))
(if (= (expm a s n) 1) #t
(let loop ((j 0) (s s))
(cond ((= j r) #f)
((= (expm a s n) (- n 1)) #t)
(else (loop (+ j 1) (* s 2)))))))))
; Zhenxiang Zhang and Min Tang, "Finding strong
; pseudoprimes to several bases. II," <em>Mathematics
; of Computation</em> 72 (2003), pp. 2085–2097,
; reported at http://math.crg4.com/primes.html.
(define (prime? n) ; n <= 318665857834031151167461
(let loop ((as '(2 3 5 7 11 13 17 19 23 29 31 37)))
(cond ((null? as) #t)
((strong-pseudo-prime? (car as) n)
(loop (cdr as)))
(else #f))))
(define (prime36? str)
(prime? (string->number str 36)))
; (display (prime36? "PRAXIS")) (newline)
; (display (prime36? "LISP")) (newline)
(define (undigits ds . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((ds ds) (n 0))
(if (null? ds) n
(loop (cdr ds) (+ (* n b) (car ds)))))))
(define (digit c)
(cond ((char<=? #\0 c #\9) (- (char->integer c) 48))
((char<=? #\A c #\Z) (- (char->integer c) 55))
((char<=? #\a c #\z) (- (char->integer c) 87))
(else (error 'digit "invalid character"))))
(define (radix36 s)
(undigits (map digit (string->list s)) 36))
(define (prime36? str)
(prime? (radix36 str)))
(display (prime36? "PRAXIS")) (newline)
(display (prime36? "LISP")) (newline)
; split a list
(define (split! xs)
(let loop ((t xs) (h (cdr xs)))
(if (or (null? h) (null? (cdr h)))
(let ((h (cdr t)))
(set-cdr! t '())
(values xs h))
(loop (cdr t) (cddr h)))))
(call-with-values
(lambda ()
(split! '(1 2 3 4)))
(lambda (f b)
(display f) (newline)
(display b) (newline)))
(call-with-values
(lambda ()
(split! '(1 2 3 4 5)))
(lambda (f b)
(display f) (newline)
(display b) (newline)))
(define (split xs)
(let loop ((xs xs) (ts '()) (hs xs))
(cond ((null? hs) (values (reverse ts) xs))
((null? (cdr hs)) (values (reverse ts) xs))
(else (loop (cdr xs) (cons (car xs) ts) (cddr hs))))))
(call-with-values
(lambda ()
(split '(1 2 3 4)))
(lambda (f b)
(display f) (newline)
(display b) (newline)))
(call-with-values
(lambda ()
(split '(1 2 3 4 5)))
(lambda (f b)
(display f) (newline)
(display b) (newline)))