Project Euler 用 汎用計算ライブラリ

;;
;; math-lib.el
;; 利用するときは、このファイルをload-pathの通ったところに置いて
;; バイトコンパイルして、require してください。

(provide 'math-lib)
(require 'cl)

(defun primes-sieve (n)
  "エラトステネスのふるい (n未満の素数を列挙)"
  (let* ((vec (make-vector n nil))
         (vec-len (length vec)))
    (do ((i 3 (+ i 2)) (lis (list 2)))
        ((<= vec-len i) (reverse lis))
      (if (null (aref vec i))
          (push i lis))
      (do ((j i (+ j i)))
          ((<= vec-len j))
        (setf (aref vec j) t)))))

(defun factorize (n primes)
  "素因数分解"
  (let ((dest) (limit (1+ (truncate (sqrt n)))))
    (do ((primes primes (cdr primes))
         (continue t))
        ((or (null continue) (null primes)))
      (let* ((pn (car primes))
             (count (do ((count 0 (1+ count)))
                        ((< 0 (mod n pn)) count)
                      (setq n (/ n pn)))))
        (cond
         ((< 0 count)
          (push (cons pn count) dest))
          ((or (>= pn n) (> pn limit))
           (setq continue nil)))))
    (if (< 1 n)
        (push (cons n 1) dest))
    (reverse dest)))

(defun de-factorize (lis)
  "素因数リストから元の合成数復元"
  (reduce #'(lambda (acc cns)
              (* acc (expt (car cns) (cdr cns))))
          lis
          :initial-value 1))

(defun get-divisors (n primes)
  "約数リスト作成"
  (let ((factors (factorize n primes))
        (dest))
    (labels
        ((repeat (lis acc)
                 (if (null lis)
                     (push acc dest)
                   (destructuring-bind (n . count) (car lis)
                     (do ((i 0 (1+ i)))
                         ((< count i))
                       (repeat (cdr lis) acc)
                       (setq acc (* acc n)))))))
      (repeat factors 1))
    dest))