; perfect totient numbers
(import (rnrs hashtables (6)))
(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-syntax define-memoized
(syntax-rules ()
((define-memoized (f arg ...) body ...)
(define f
(let ((cache (make-eq-hashtable)))
(lambda (arg ...)
(cond ((hashtable-ref cache `(,arg ...) #f) => car)
(else (let ((val (begin body ...)))
(hashtable-set! cache `(,arg ...) val)
val)))))))))
(define-memoized (totient n)
(let ((wheel (vector 1 2 2 4 2 4 2 4 6 2 6)))
(let loop ((n n) (t n) (f 2) (w 0))
(if (< n (* f f))
(if (< 1 n) (- t (/ t n)) t)
(if (zero? (modulo n f))
(begin (while (zero? (modulo n f))
(set! n (/ n f)))
(loop n (- t (/ t f))
(+ f (vector-ref wheel w))
(if (= w 10) 3 (+ w 1))))
(loop n t (+ f (vector-ref wheel w))
(if (= w 10) 3 (+ w 1))))))))
(define (iterated-totient-sum n)
(let loop ((n n) (s 0))
(if (= n 1) s
(let ((t (totient n)))
(loop t (+ s t))))))
(display (filter (lambda (n) (= (iterated-totient-sum n) n)) (range 1 1000)))