; feynman's puzzle
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
((_ "z" f b e (v range fst pst stp) c ...)
(let* ((x fst) (p pst) (s stp)
(le? (if (positive? s) <= >=)))
(do ((v x (+ v s))) ((le? p v) b)
(fold-of "z" f b e c ...))))
((_ "z" f b e (v range fst pst) c ...)
(let* ((x fst) (p pst) (s (if (< x p) 1 -1)))
(fold-of "z" f b e (v range x p s) c ...)))
((_ "z" f b e (v range pst) c ...)
(fold-of "z" f b e (v range 0 pst) c ...))
((_ "z" f b e (x in xs) c ...)
(do ((t xs (cdr t))) ((null? t) b)
(let ((x (car t)))
(fold-of "z" f b e c ...))))
((_ "z" f b e (x is y) c ...)
(let ((x y)) (fold-of "z" f b e c ...)))
((_ "z" f b e p? c ...)
(if p? (fold-of "z" f b e c ...)))
((_ f i e c ...)
(let ((b i)) (fold-of "z" f b e c ...)))))
(define-syntax list-of (syntax-rules ()
((_ arg ...) (reverse (fold-of
(lambda (d a) (cons a d)) '() arg ...)))))
(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))))))
(display
(list-of (list (list b a c) (list d e a f))
; initialize digits
(a range 10) (b range 1 10) (c range 10)
(d range 1 10) (e range 10) (f range 10)
; A differs from the other digits
(not (= a b)) (not (= a c)) (not (= a d))
(not (= a e)) (not (= a f))
; calculate the two numbers
(n1 is (+ (* b 100) (* a 10) c))
(n2 is (+ (* d 1000) (* e 100) (* a 10) f))
; answer must be seven digits
(< 999999 (* n1 n2) 10000000)
; fifth digit of answer must be A
(= (list-ref (digits (* n1 n2)) 4) a)
; d * bAc must be AA modulo 100
(= (modulo (* d n1) 100) (+ (* a 10) a))
; e * bAc must be A modulo 10
(= (modulo (* e n1) 10) a)
; A * bAc must be four digits
(< 999 (* a n1))
; second digit of A * bAc must be A
(= (list-ref (digits (* a n1)) 1) a)))
(newline)
(display
(list-of (list (list b a c) (list d e a f))
; initialize digits
(a range 10) (b range 1 10) (c range 10)
(d range 1 10) (e range 10) (f range 10)
; A differs from the other digits
(not (= a b)) (not (= a c)) (not (= a d))
(not (= a e)) (not (= a f))
; calculate the two numbers
(n1 is (+ (* b 100) (* a 10) c))
(n2 is (+ (* d 1000) (* e 100) (* a 10) f))
; answer must be seven digits
(< 999999 (* n1 n2) 10000000)
; fifth digit of answer must be A
(= (list-ref (digits (* n1 n2)) 4) a)
; d * bAc must be AA modulo 100
(= (modulo (* d n1) 100) (+ (* a 10) a))
; e * bAc must be A modulo 10
(= (modulo (* e n1) 10) a)
; A * bAc must be four digits
(< 999 (* a n1))
; second digit of A * bAc must be A
(= (list-ref (digits (* a n1)) 1) a)
; e must be less than d
(< e d)))