fork download
copy 
  1. ; perfect totient numbers
  2.  
  3. (import (rnrs hashtables (6)))
  4.  
  5. (define (range . args)
  6.   (case (length args)
  7.     ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
  8.     ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
  9.     ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
  10.            (let loop ((x(car args)) (xs '()))
  11.              (if (le? (cadr args) x)
  12.                  (reverse xs)
  13.                  (loop (+ x (caddr args)) (cons x xs))))))
  14.     (else (error 'range "unrecognized arguments"))))
  15.  
  16. (define-syntax define-memoized
  17.   (syntax-rules ()
  18.     ((define-memoized (f arg ...) body ...)
  19.       (define f
  20.         (let ((cache (make-eq-hashtable)))
  21.           (lambda (arg ...)
  22.             (cond ((hashtable-ref cache `(,arg ...) #f) => car)
  23.             (else (let ((val (begin body ...)))
  24.                     (hashtable-set! cache `(,arg ...) val)
  25.                     val)))))))))
  26.  
  27. (define-memoized (totient n)
  28.   (let ((wheel (vector 1 2 2 4 2 4 2 4 6 2 6)))
  29.     (let loop ((n n) (t n) (f 2) (w 0))
  30.       (if (< n (* f f))
  31.           (if (< 1 n) (- t (/ t n)) t)
  32.           (if (zero? (modulo n f))
  33.               (begin (while (zero? (modulo n f))
  34.                        (set! n (/ n f)))
  35.                      (loop n (- t (/ t f))
  36.                            (+ f (vector-ref wheel w))
  37.                            (if (= w 10) 3 (+ w 1))))
  38.               (loop n t (+ f (vector-ref wheel w))
  39.                     (if (= w 10) 3 (+ w 1))))))))
  40.  
  41. (define (iterated-totient-sum n)
  42.   (let loop ((n n) (s 0))
  43.     (if (= n 1) s
  44.       (let ((t (totient n)))
  45.         (loop t (+ s t))))))
  46.  
  47. (display (filter (lambda (n) (= (iterated-totient-sum n) n)) (range 1 1000)))
Success #stdin #stdout 1.23s 59352KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(3 9 15 27 39 81 111 183 243 255 327 363 471 729)
https://ideone.com/TzNR0v
language:
Scheme (guile 2.2.4)
created:
5 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!