codepad

Language:

; 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)

Private [?]

Run code