; excellent numbers
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
((pred? (car xs))
(loop (cdr xs) (cons (car xs) ys)))
(else (loop (cdr xs) ys)))))
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
((3) (let ((le? (if (negative? (caddr args)) >= <=)))
(let loop ((x(car args)) (xs '()))
(if (le? (cadr args) x)
(reverse xs)
(loop (+ x (caddr args)) (cons x xs))))))
(else (error 'range "unrecognized arguments"))))
(define (sum xs) (apply + xs))
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
(let loop ((x n))
(let ((y (quotient (+ x (quotient n x)) 2)))
(if (< y x) (loop y) x)))))
(define (ilog b n)
(let loop1 ((lo 0) (b^lo 1) (hi 1) (b^hi b))
(if (< b^hi n) (loop1 hi b^hi (* hi 2) (* b^hi b^hi))
(let loop2 ((lo lo) (b^lo b^lo) (hi hi) (b^hi b^hi))
(if (<= (- hi lo) 1) (if (= b^hi n) hi lo)
(let* ((mid (quotient (+ lo hi) 2))
(b^mid (* b^lo (expt b (- mid lo)))))
(cond ((< n b^mid) (loop2 lo b^lo mid b^mid))
((< b^mid n) (loop2 mid b^mid hi b^hi))
(else mid))))))))
(define (xl? n)
(let* ((k (/ (+ (ilog 10 n) 1) 2))
(ten (expt 10 k))
(a (quotient n ten))
(b (modulo n ten)))
(= (- (* b b) (* a a)) n)))
(time (display
(sum
(filter xl
? (range
1000 10000)))) (newline
))
(define (xl-sum k)
(let ((ten (expt 10 k))
(start (expt 10 (+ k k -1)))
(stop (expt 10 (+ k k))))
(let loop ((n start) (sum 0))
(if (= n stop) sum
(let ((a (quotient n ten))
(b (modulo n ten)))
(if (= (- (* b b) (* a a)) n)
(loop (+ n 1) (+ sum n))
(loop (+ n 1) sum)))))))
(time (display
(xl
-sum
2)) (newline
))
(define (xl-list k)
(let ((ten (expt 10 k))
(start (expt 10 (- k 1)))
(stop (expt 10 k)))
(let loop ((a start) (xls (list)))
(if (= a stop) (reverse xls)
(let* ((b (+ (isqrt (* a (+ ten a))) 1))
(n (+ (* a ten) b)))
(if (= (- (* b b) (* a a)) n)
(loop (+ a 1) (cons n xls))
(loop (+ a 1) xls)))))))
(define xl-ten #f)
(time (set
! xl
-ten
(xl
-list
5))) (display xl-ten) (newline)
(display (sum xl-ten)) (newline)