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 追加