; triperfect numbers

(define (factors n)
  (let ((wheel (vector 1 2 2 4 2 4 2 4 6 2 6)))
    (let loop ((n n) (f 2) (w 0) (fs (list)))
      (cond ((< n (* f f)) (reverse (cons n fs)))
            ((zero? (modulo n f))
              (loop (/ n f) f w (cons f fs)))
            (else (loop n (+ f (vector-ref wheel w))
                        (if (= w 10) 3 (+ w 1)) fs))))))

(define (divisors n) ; divisors of n, including 1 and n
  (let ((divs (list 1)))
    (do ((fs (factors n) (cdr fs))) ((null? fs) (sort divs <))
      (let ((temp (list)))
        (do ((ds divs (cdr ds)))
            ((null? ds) (set! divs (append divs temp)))
          (let ((d (* (car fs) (car ds))))
            (when (not (member d divs))
              (set! temp (cons d temp)))))))))

(define (multi-perfect k)
  (do ((n 1 (+ n 1))) ((= n 1000))
    (when (= (apply + (divisors n)) (* k n))
      (display n) (newline))))

(multi-perfect 3)