Project Euler 多倍長演算ライブラリ

　今後も使うかもしれないのでここにまとめておきます。
　加算、乗算、累乗、階乗が実装済みです。

多倍長演算ライブラリ

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

(provide 'bigint)
(require 'cl)

(defun integer-to-bigint (n)
  "整数を多倍長整数へ"
  (if (< n 10000)
      (list n)
    (let ((stack) (m))
      (while (> n 0)
        (push (% n 10000) stack)
        (setq n (/ n 10000)))
      (reverse stack))))

(defun string-to-bigint (str)
  "文字列を多倍長整数へ"
  (let ((stack nil)
        (d 1) (c 0) (n 0))
    (dolist (c (reverse (string-to-list str)))
      (incf n (* (- c ?0) d))
      (when (< 1000 (setq d (* d 10)))
        (push n stack)
        (setq n 0 d 1)))
    (reverse (if (< 1 d)
                 (cons n stack)
               stack))))

(defun bigint-to-string (n)
  "多倍長整数を文字列へ"
  (if (= 1 (length n))
      (number-to-string (car n))
    (let ((n (reverse n)))
      (apply #'concat
             (cons
              (number-to-string (car n))
              (mapcar #'(lambda (x)
                          (format "%04d" x))
                      (cdr n)))))))

(defun bigint-length (n)
  "桁数を取得"
  (let ((m (reverse n)))
    (+ (length (number-to-string (car m)))
       (* 4 (length (cdr m))))))

(defun bigint+ (n1 n2)
  "加算"
  (let* ((long-n (if (< (length n1) (length n2)) n2 n1))
         (short-n (if (eq long-n n1) n2 n1))
         (carry 0)
         (lis (mapcar
               #'(lambda (x)
                   (let ((n (+ carry x (pop long-n))))
                     (setq carry (/ n 10000))
                     (% n 10000)))
               short-n)))
    (if (zerop carry)
        (append lis long-n)
      (let ((stack nil)
            (len-remain (length long-n)))
        (while (and (< 0 carry)
                    (<= 0 (decf len-remain)))
          (let ((n (+ carry (pop long-n))))
            (push (% n 10000) stack)
            (setq carry (/ n 10000))))
        (if (< 0 carry)
            (append lis (reverse stack) (list carry))
          (append lis (reverse stack) long-n))))))

(defun bigint* (n1 n2)
  "乗算"
  (let* ((long-n (if (< (length n1) (length n2)) n2 n1))
         (short-n (if (eq long-n n1) n2 n1))
         (result '(0))
         (a 0) (d nil))
    (dolist (a short-n result)
      (when (< 0 a)
        (let* ((carry 0)
               (lis (mapcar
                     #'(lambda (b)
                         (let ((n (+ (* a b) carry)))
                           (setq carry (/ n 10000))
                           (% n 10000)))
                     long-n)))
          (setq result
                (bigint+
                 result
                 (if (zerop carry)
                     (append d lis)
                   (append d lis (list carry)))))))
      (push 0 d))))

(defun bigint-expt (n m)
  "累乗計算。n:bigint, m:0以上の整数"
  (let ((result '(1)) (i 0) (cnt 0))
    (while (zerop (/ m 2))
      (incf cnt)
      (setq m (/ m 2)))
    (while (<= 0 (decf m))
      (setq result (bigint* result n)))
    (while (<= 0 (decf cnt))
      (setq result (bigint* result result)))
    result))

(defun bigint-fact (n)
  "階乗計算。n:0以上の整数"
  (do ((m 2 (1+ m))
       (result (string-to-bigint "1")))
      ((< n m) result)
    (setq result
          (bigint* result
                   (string-to-bigint
                    (number-to-string m))))))

2009/11/28 bigint-length 追加
2009/12/04 bigint* バグ修正、integer-to-bigint 追加