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