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