Skip to content

Instantly share code, notes, and snippets.

@chuntaro
Last active February 12, 2021 07:47
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save chuntaro/ba72900728f365400c4645b8cd022008 to your computer and use it in GitHub Desktop.
Save chuntaro/ba72900728f365400c4645b8cd022008 to your computer and use it in GitHub Desktop.
Emacs Lisp で実装する、9つのフィボナッチ関数
;;; -*- lexical-binding: t; -*-
;; Emacs Lisp で実装する、9つのフィボナッチ関数
;; 内訳は以下の通り
;;
;; 再帰呼び出し系
;; fib-tail-recursion
;; fib-double-recursion
;;
;; ループ系 (マクロを展開すると結局は同じ様なコードになるけど、色々な書き方が出来る)
;; fib-while
;; fib-dotimes
;; fib-cl-loop
;; fib-cl-do
;;
;; 無限リスト系
;; fib-generator
;; fib-stream
;;
;; スタックマシーン系
;; fib-lapcode
(require 'cl-lib)
(require 'subr-x)
(require 'seq)
;;
;; 1. 末尾再帰版
;;
(defun fib-tail-recursion (n)
"末尾再帰版"
(cl-labels ((rec (a b n)
(if (zerop n)
a
(rec b (+ a b) (1- n))))) ; (1- n) は (- n 1) と同じ
(rec 0 1 n)))
;;
;; 2. 二重再帰版
;;
(defun fib-double-recursion (n)
"二重再帰版"
(if (< n 2)
n
(+ (fib-double-recursion (1- n)) (fib-double-recursion (- n 2)))))
;;
;; 3. while 版
;;
(defun fib-while (n)
"while 版"
(let ((a 0)
(b 1))
(while (/= n 0)
(cl-psetq a b
b (+ a b))
(cl-decf n))
a))
(defun fib-while (n)
"while 版 (マクロ展開後)"
(let ((a 0)
(b 1))
(while (/= n 0)
(setq a (prog1 b (setq b (+ a b))))
(setq n (1- n)))
a))
;;
;; 4. dotimes 版
;;
(defun fib-dotimes (n)
"dotimes 版"
(let ((a 0)
(b 1))
(dotimes (_ n) ; ループ変数は使わないので`_'にして未使用の警告を抑制する
(cl-psetq a b
b (+ a b)))
a))
;; (defun fib-dotimes (n)
;; "dotimes 版 (マクロ展開後)"
;; (let ((a 0)
;; (b 1))
;; (let ((--dotimes-limit-- n)
;; (--dotimes-counter-- 0))
;; (while (< --dotimes-counter-- --dotimes-limit--)
;; (let ((_ --dotimes-counter--))
;; (progn
;; (setq a (prog1 b (setq b (+ a b))))
;; nil))
;; (setq --dotimes-counter-- (1+ --dotimes-counter--))))
;; a))
;;
;; 5. cl-loop 版
;;
(defun fib-cl-loop (n)
"cl-loop 版"
(cl-loop repeat n
for a = 0 then b
and b = 1 then (+ a b)
finally (return a)))
;; (defun fib-cl-loop (n)
;; "cl-loop 版 (マクロ展開後)"
;; (let* ((#:--cl-var-- n))
;; (let ((a nil)
;; (b nil))
;; (let* ((#:--cl-var-- t))
;; (while (>= (setq #:--cl-var-- (1- #:--cl-var--)) 0)
;; (progn
;; (setq a (if #:--cl-var-- 0 a)
;; b (if #:--cl-var-- 1 b))
;; nil)
;; (progn
;; (setq a (prog1 b (setq b (+ a b))))
;; nil)
;; (setq #:--cl-var-- nil))
;; a))))
;;
;; 6. cl-do 版
;;
(defun fib-cl-do (n)
"cl-do 版"
(cl-do ((a 0 b)
(b 1 (+ a b)))
((zerop n) a)
(cl-decf n)))
;; (defun fib-cl-do (n)
;; "cl-do 版 (n を初期化フォームに書くやり方)"
;; (cl-do ((a 0 b)
;; (b 1 (+ a b))
;; (n n (1- n)))
;; ((zerop n) a)))
;; (defun fib-cl-do (n)
;; "cl-do 版 (マクロ展開後)"
;; (let ((a 0)
;; (b 1))
;; (while (not (= 0 n))
;; (setq n (1- n))
;; (progn
;; (setq a (prog1 b (setq b (+ a b))))
;; nil))
;; a))
;; (defun fib-cl-do (n)
;; "cl-do 版 (n を初期化フォームに書くやり方) (マクロ展開後)"
;; (let ((a 0)
;; (b 1)
;; (n n))
;; (while (not (= 0 n))
;; (progn
;; (setq a (prog1 b (setq b (prog1 (+ a b)
;; (setq n (1- n))))))
;; nil))
;; a))
;;
;; 7. generator 版
;;
(require 'generator)
(iter-defun fib-generator ()
"generator 版"
(let ((a 0)
(b 1))
(while t
(iter-yield a)
(cl-psetq a b
b (+ a b)))))
;; (defun fib-generator ()
;; "generator 版 (マクロ展開後)"
;; (let ((a 0)
;; (b 1)
;; current-state
;; current-value
;; state-terminal
;; state-atom-1
;; state-atom-2
;; state-iter-yield
;; state-atom-3
;; state-while)
;; (setq state-terminal (lambda ()
;; (signal 'iter-end-of-sequence current-value)))
;; (setq state-atom-1 (lambda ()
;; (setq current-value (prog1 t
;; (setq current-state state-while)))))
;; (setq state-atom-2 (lambda ()
;; (setq current-value (prog1 (cl-psetq a b
;; b (+ a b))
;; (setq current-state state-atom-1)))))
;; (setq state-iter-yield (lambda ()
;; (setq current-state state-atom-2)
;; (throw 'yield current-value)))
;; (setq state-atom-3 (lambda ()
;; (setq current-value (prog1 a
;; (setq current-state state-iter-yield)))))
;; (setq state-while (lambda ()
;; (setq current-state (if current-value
;; state-atom-3
;; state-terminal))))
;; (setq current-state state-atom-1)
;; (let ((iterator (lambda (op value)
;; (cond
;; ((eq op :close)
;; (setq current-state state-terminal)
;; (setq current-value nil))
;; ((eq op :next)
;; (setq current-value value)
;; (let ((yielded nil))
;; (unwind-protect
;; (prog1 (catch 'yield
;; (while t
;; (funcall current-state)))
;; (setq yielded t))
;; (if yielded
;; nil
;; (setq current-state state-terminal)
;; (setq current-value nil)))))
;; (t (error "unknown iterator operation %S" op))))))
;; iterator)))
;;
;; 8. 遅延評価(stream)版
;;
(when (require 'stream nil t) ; stream.el がインストールされている時だけ定義する
(defun fib-stream ()
"遅延評価(stream)版"
(cl-labels ((rec (a b)
(stream-cons (+ a b)
(rec b (+ a b)))))
(stream-cons 0 (stream-cons 1 (rec 0 1))))))
;;
;; 9. lapcode 版
;;
(defalias 'fib-lapcode
(make-byte-code
#x101 ;; 必須引数1つ
(let ((tag1 (byte-compile-make-tag))
(tag2 (byte-compile-make-tag)))
;; tag1 は (TAG 1) というただのリストだが、lapcode に直接書いてはいけない!
;; tag の比較には eq が使われているので、このようにする必要がある。
(byte-compile-lapcode
;; lapcode
`((byte-constant . 0) ;; この 0 は定数のゼロではなくて定数ベクターのインデックス
(byte-constant . 1)
,tag1
(byte-stack-ref . 2) ;; スタックトップ(以下 TOP) + 2 にある値をスタックに積む
(byte-constant . 0)
(byte-eqlsign . 0) ;; TOP から2つの値を = で比較して結果をスタックに積む
(byte-goto-if-not-nil . ,tag2) ;; TOP の値が nil で無い場合はタグへジャンプする
(byte-dup . 0) ;; TOP の値をスタックに積む (複製する)
(byte-stack-ref . 2)
(byte-stack-ref . 2)
(byte-plus . 0) ;; TOP から2つの値を + で計算して結果をスタックに積む
(byte-stack-set . 2) ;; TOP の値を TOP + 2 の位置に書き込む
(byte-stack-set . 2)
(byte-stack-ref . 2)
(byte-sub1 . 0) ;; TOP の値から 1 を引いて結果をスタックに積む
(byte-stack-set . 3)
(byte-goto . ,tag1) ;; 指定のタグへジャンプする
,tag2
(byte-stack-ref . 1)
(byte-return . 0)))) ;; TOP の値を戻り値として関数から抜ける
[0 1] ;; 定数ベクター
6) ;; 最大スタック使用量
"lapcode 版")
;;;
;;; テスト
;;;
(defconst fibonacci-numbers
'(0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181
6765 10946 17711 28657 46368 75025 121393 196418 317811 514229
832040 1346269 2178309 3524578 5702887 9227465 14930352 24157817
39088169 63245986 102334155 165580141 267914296 433494437
701408733 1134903170 1836311903 2971215073 4807526976 7778742049
12586269025 20365011074 32951280099 53316291173 86267571272
139583862445 225851433717 365435296162 591286729879 956722026041
1548008755920 2504730781961 4052739537881 6557470319842
10610209857723 17167680177565 27777890035288 44945570212853
72723460248141 117669030460994 190392490709135 308061521170129
498454011879264 806515533049393 1304969544928657
2111485077978050 3416454622906707 5527939700884757
8944394323791464 14472334024676221 23416728348467685
37889062373143906 61305790721611591 99194853094755497
160500643816367088 259695496911122585 420196140727489673
679891637638612258 1100087778366101931 1779979416004714189)
"0〜89項まで (https://fibonnacci.aimary.com/) から取得。
89項は most-positive-fixnum 以下の最大値。")
;; 使う値を予め保存しておく
(defconst fibonacci-20 (nth 20 fibonacci-numbers) "=> 6765")
(defconst fibonacci-0-19 (seq-subseq fibonacci-numbers 0 20)
"=> '(0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181)")
(defconst fibonacci-88 (nth 88 fibonacci-numbers) "=> 1100087778366101931")
;; fib-* 関数を集める
(let (result)
(mapatoms (lambda (sym)
(let ((name (symbol-name sym)))
(when (and (< 4 (length name))
(string= (substring name 0 4) "fib-"))
(push sym result)))))
(defconst fibs result))
;; バイトコンパイルしておく (fib-lapcode は既にバイトコードなのでスキップされる)
(mapc #'byte-compile fibs)
;; 二重再帰版は重いので小さい数値でテスト
(ert-deftest test-fib-double-recursion ()
(should (= (fib-double-recursion 20) fibonacci-20)))
;; generator 版は途中の値を取得出来るのでテスト方法を変える
(ert-deftest test-fib-generator ()
(should (equal (cl-loop repeat 20
for i iter-by (fib-generator)
collect i)
fibonacci-0-19)))
;; 遅延評価(stream)版も同様に無限リストを取得出来るのでテスト方法を変える
(ert-deftest test-fib-stream ()
(should (equal (seq-into (seq-take (fib-stream) 20) 'list)
fibonacci-0-19)))
;; それ以外は、同じテストを定義する
(defmacro make-test ()
`(progn
,@(cl-mapcan (lambda (fib)
(let ((test-fib (concat "test-" (symbol-name fib))))
(unless (intern-soft test-fib)
(list `(ert-deftest ,(intern test-fib) ()
(should (= (,fib 88) ,fibonacci-88)))))))
fibs)))
(make-test)
(ert-run-tests-batch-and-exit)
;; $ emacs --batch -f package-initialize -l fibs.el
;; Function fib-lapcode is already compiled
;; Running 9 tests (2021-02-12 16:38:34+0900, selector `t')
;; passed 1/9 test-fib-cl-do (0.000116 sec)
;; passed 2/9 test-fib-cl-loop (0.000083 sec)
;; passed 3/9 test-fib-dotimes (0.000065 sec)
;; passed 4/9 test-fib-double-recursion (0.001994 sec)
;; passed 5/9 test-fib-generator (0.000210 sec)
;; passed 6/9 test-fib-lapcode (0.000063 sec)
;; passed 7/9 test-fib-stream (0.000209 sec)
;; passed 8/9 test-fib-tail-recursion (0.000084 sec)
;; passed 9/9 test-fib-while (0.000064 sec)
;;
;; Ran 9 tests, 9 results as expected, 0 unexpected (2021-02-12 16:38:34+0900, 0.003326 sec)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment