home | new paste

(use-modules ((rnrs) :version (6) :select (div-and-mod))
             (srfi srfi-11))

;; A hard limit. Above this, we refuse to compute.
(define (exponent-computible? n)
  (< (log10 n) 5))

(define (get-fractional n)
  (- n (floor n)))

(define (fold-digits f n a)
  (cond
   ((> 10 n) (f a n))
   (else
    (let-values (((rest digit) (div-and-mod n 10)))
      (fold-digits f rest (f a digit))))))

(define (number->list n)
  (fold-digits (lambda (t h) (cons h t)) n '()))

(define (do-exponents rest)
  (cond
   ((null? rest) 1)
   (else
    (let ((n (do-exponents (cdr rest))))
      (if (and n (exponent-computible? n))
          (expt (car rest) n)
          #f)))))

(define (approximate first exponent len)
  (let ((exponent10 (* (log10 first) exponent)))
    (if (finite? exponent10)
        (expt 10
              (min exponent10
                   (+ (get-fractional exponent10) len 2)))
        ;; Just lie about the result if inexact numbers can't
        ;; represent them.
        0)))

(define (equal-digits? a b)
  (cond
   ((null? a) (or (null? b)             ; TODO the zero case really
                  (= 1 (car b))         ; should check for odd zeroes.
                  (and (not (null? (cdr b)))
                       (= 0 (cadr b)))))
   ((null? b) #f)
   (else (and (= (car a) (car b))
              (equal-digits? (cdr a) (cdr b))))))

(define (special? first second rest len)
  (let* ((exponent (do-exponents (cons second rest)))
         (approx (and exponent
                      (if (= first 4)
                          (approximate 2 exponent len)
                          (approximate first (/ exponent 2) len)))))
    (and=> approx (lambda (v)
                    (equal-digits? `(,first ,second ,@rest)
                                   (number->list v))))))

(define (increment-digits r)
  (cond
   ((null? r) '(2))
   ((= 9 (car r)) (cons 2 (increment-digits (cdr r))))
   (else (cons (+ 1 (car r)) (cdr r)))))

(define (enumerate-specials first second rest len)
  (when (special? first second rest len)
    (display `(,first ,second ,@rest))
    (newline))
  ;; Check only up to 6 digits
  (unless (> len 6)
    (cond
     ((= first 9)
      (if (= second 9)
          (let ((new-rest (increment-digits rest)))
            (enumerate-specials 2 2 new-rest (+ 2 (length new-rest))))
          (enumerate-specials 2 (+ 1 second) rest len)))
     (else (enumerate-specials (+ first 1) second rest len)))))

;; This finds only the known solution, (2 6 2).
(enumerate-specials 2 2 '() 2)