; k-factorials and factorions
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
(if (zero? n) d
(loop (quotient n b)
(cons (modulo n b) d))))))
(define (sum xs) (apply + xs))
(define (factorion? n k b)
(let ((ks (make-vector 10 1)))
; (vector-set! ks 0 0)
(do ((d 2 (+ d 1))) ((= d 10))
(do ((i 1 (+ i 1))) ((< d i))
(if (= (modulo d k) (modulo i k))
(vector-set! ks d (* i (vector-ref ks d))))))
(let loop ((ds (digits n b)) (f 0))
(if (null? ds) (= f n)
(loop (cdr ds) (+ f (vector-ref ks (car ds))))))))
(display (factorion? 145 1 10)) (newline)
(display (factorion? 81 3 10)) (newline)
(define (factorions k b)
(let ((ks (make-vector b 1)))
(do ((d 2 (+ d 1))) ((= d b))
(do ((i 1 (+ i 1))) ((< d i))
(when (= (modulo d k) (modulo i k))
(vector-set! ks d (* i (vector-ref ks d))))))
(do ((n 1 (+ n 1))) (#f)
(when (= n (sum (map (lambda (d) (vector-ref ks d)) (digits n b))))
(display n) (newline)))))
; (factorions 1 6)
(do ((n 1 (+ n 1))) ((< 50 n))
(when (factorion? n 1 6)
(display n) (newline)))