簡易スタック型VM(バイトコードインタプリタ)でのフィボナッチ数計算速度
今年はlisp系のプログラミング言語(及びその処理系)を作ってみようと考えていて、かつ(少なくとも)当面の間はスタック型VMを基盤として実装していくことになると思われるので、まずは単純なスタックマシンのバイトコードインタプリタで、どの程度の処理速度がでるのかを計測してみた。
命令一覧と実行サンプル
現状のVMが備える命令一覧*1。必要最小限。
下記、命令セットに関してはForthを少し参考にしている。スタックマシンの動作の詳細に関しては、特に特殊な点もないので説明は割愛。
命令 | コード値 | in-stack | out-stack | 意味 |
---|---|---|---|---|
int | 1 | n | バイトコード中の後続の四バイト(little-endian)を取り出し、int値を生成 | |
add | 2 | n1 n2 | n3 | n1 + n2 |
sub | 3 | n1 n2 | n3 | n1 - n2 |
mul | 4 | n1 n2 | n3 | n1 * n2 |
div | 5 | n1 n2 | n3 | n1 / n2 |
mod | 6 | n1 n2 | n3 | n1 % n2 |
eql | 7 | n1 n2 | b(1 or 0) | n1 == n2 |
less | 8 | n1 n2 | b | n1 < n2 |
dup | 9 | x | x x | スタックの先頭要素を複製 |
drop | 10 | x | スタックの先頭要素を破棄 | |
swap | 11 | x1 x2 | x2 x1 | スタックの先頭二つの要素を入れ替え |
over | 12 | x1 x2 | x1 x2 x1 | スタックの二番目の要素を先頭に複製 |
rot | 13 | x1 x2 x3 | x2 x3 x1 | スタックの先頭三つの要素をローテーション |
rpush | 14 | x | スタック(データスタック)の先頭要素をリターンスタックの先頭に移す | |
rpop | 15 | x | リターンスタックの先頭要素をスタックに移す | |
rcopy | 16 | x | リターンスタックの先頭要素をスタックに複製 | |
jump | 17 | n | 無条件分岐。nは分岐先のアドレス | |
jump_if | 18 | b n | 条件分岐。bが新(非ゼロ)なら分岐する | |
call | 19 | n | 関数呼び出し。リターンスタックにプログラムカウンタを保存後、無条件分岐 | |
return | 20 | 関数からの復帰。リターンスタックからプログラムカウンタを取り出し、そこへ無条件分岐 |
末尾にソースコード全体を載せるが、バイトコードインタプリタの実行部は、バイトコードから上記命令に対応するコード値を取得し、命令を実行する、ということをひたすら繰り返すという単純なもの。
// C++ typedef unsigned char octet; /** * バイトコード実行用のクラス */ class executor { public: void execute(const char* filepath) { bytecode_stream in(filepath); // バイトコードストリームの終端に達するまでループ while(in.eos() == false) { octet opcode = in.read_octet(); // 命令コード読み出し op::call(opcode, in, env); // コードに対応する処理を実行 (envにはデータスタックとリターンスタックが保持されている) } } }; class op { public: // コードに対応する命令を実行 static void call(octet opcode, bytecode_stream& in, environment& env) { switch(opcode) { case 1: op_int(in, env); break; // int値構築 case 2: op_add(in, env); break; // + case 3: op_sub(in, env); break; // - case 4: op_mul(in, env); break; // * case 5: op_div(in, env); break; // / case 6: op_mod(in, env); break; // % case 7: op_eql(in, env); break; // == ... 省略 ... default: assert(false); } } }
VM部はC++で記述しているが、VMが解釈可能なバイトコード列を生成するためのアセンブラ(コンパイラ)はcommon lispで作成。
;; common lisp ;; 実行例 (load "pvm-compile") ;; 加算を行うバイトコード列を'add.bc'ファイルに出力する ;; - キーワードは命令を表す (pvmc:compile-to-file "add.bc" '(10 20 :add)) ; 10 + 20 ;; 条件分岐を行うバイトコード列を'jump.bc'ファイルに出力する ;; ;; シンボルはアドレス参照用のラベルを表す ;; (:addr シンボル)形式で参照可能 ;; ※ アドレスはコンパイル時に解決される (pvmc:compile-to-file "jump.bc" '(10 10 :eql ; n1 == n2 ? (:addr then) :jump-if ; 等しいなら then に移動 else 1 2 ; else: スタックに 1と2 を積む (:addr end) :jump then 3 4 ; then: スタックに 3と4 を積む end)) ;; 上の例では以下のようなバイト列が生成される (pvmc::compile-to-bytecodes '(10 10 :eql (:addr then) :jump-if else 1 2 (:addr end) :jump then 3 4 end)) => #(1 10 0 0 0 1 10 0 0 0 7 1 33 0 0 0 18 1 1 0 0 0 1 2 0 0 0 1 43 0 0 0 17 1 3 0 0 0 1 4 0 0 0)
生成したバイトコードはpvmコマンドで実行可能。
# pvmコマンド作成 $ g++ -O2 -o pvm pvm.cc # add.bc $ ./pvm add.bc [data stack] # 実行後のデータスタックとリターンスタックの中身が出力される 0# 30 # 10 + 20 [return stack] # jump.bc $ ./pvm jump.bc [data stack] 0# 4 # then部が実行された 1# 3 [return stack]
実行速度
上のVM上でのフィボナッチ数の計算に要した時間。
以下は35のフィボナッチ数計算用のコード。
(pvmc:compile-to-file "fib.bc" '( 35 ; fib(35) (:addr fib-beg) :call ; fib(25) (:addr finish) :jump fib-beg :dup 2 :less (:addr fib-end) :jump-if ; if(n < 2) :dup 2 :sub (:addr fib-beg) :call ; fib(n - 2) :swap 1 :sub (:addr fib-beg) :call ; fib(n - 1) :add fib-end :return finish)) #| 実行結果: $ time ./pvm fib.bc [data stack] 0# 9227465 [return stack] real 0m3.605s user 0m3.600s sys 0m0.000s |#
他言語との比較。
言語 | 所要時間(最適化オプションなし) | 所要時間(最適化オプションあり) |
---|---|---|
gcc-4.6.1 | 0.112s | 0.056s |
sbcl-1.0.54 | 0.320s | 0.110s |
pvm | 3.600s | |
ruby1.9.1 | 2.816s | |
ruby1.8.7 | 14.497s |
現状は本当に単純なインタプリタなので仕方がないとはいえ、Ruby(1.9)よりも遅い・・・。
ちなみに各言語用のソースコードは以下の通り。
// C++ // ファイル名: fib.cc // コンパイル: g++ -O2 -o fib fib.cc // 実行: time fib 35 #include <iostream> #include <cstdlib> int fib(int n) { if(n < 2) { return n; } return fib(n-2) + fib(n-1); } int main(int argc, char** argv) { std::cout << fib(atoi(argv[1])) << std::endl; return 0; }
;; sbcl (defun fib (n) (declare (optimize (speed 3) (safety 0) (debug 0)) (fixnum n)) (if (< n 2) n (the fixnum (+ (fib (- n 2)) (fib (- n 1)))))) ;; 実行 (time (fib 35))
# ruby # ファイル名: fib.rb # 実行: time fib.rb 35 def fib (n) return n if n < 2 fib(n-2) + fib(n-1) end p fib(ARGV[0].to_i)
ソースコード
VM及びコンパイラ用のソースコード。
それぞれ180行、80行程度。
// ファイル名: pvm.hh /** * バイトコードインタプリタ */ #ifndef PVM_HH #define PVM_HH #include <iostream> #include <fstream> #include <cassert> #include <vector> #include <algorithm> namespace pvm { typedef unsigned char octet; typedef std::vector<int> stack_t; /** * バイトコード読み込みストリーム */ class bytecode_stream { public: bytecode_stream(const char* filepath) : bytecodes(NULL), position(0) { std::ifstream in(filepath); assert(in); length = in.rdbuf()->in_avail(); bytecodes = new octet[length]; in.read((char*)bytecodes, length); } ~bytecode_stream() { delete [] bytecodes; } bool eos() const { return position >= length; } octet read_octet () { return bytecodes[position++]; } // sizeof(int) == 4 と仮定 int read_int() { int n = *(int*)(bytecodes + position); position += 4; return n; } // program counter unsigned pc() const { return position; } unsigned& pc() { return position; } private: octet* bytecodes; unsigned length; unsigned position; }; /** * データスタックとリターンスタック */ class environment { public: stack_t& dstack() { return data_stack; } stack_t& rstack() { return return_stack; } const stack_t& dstack() const { return data_stack; } const stack_t& rstack() const { return return_stack; } private: stack_t data_stack; stack_t return_stack; }; /** * 各種操作(命令) */ class op { public: static void call(octet opcode, bytecode_stream& in, environment& env) { switch(opcode) { case 1: op_int(in, env); break; // int値構築 case 2: op_add(in, env); break; // + case 3: op_sub(in, env); break; // - case 4: op_mul(in, env); break; // * case 5: op_div(in, env); break; // / case 6: op_mod(in, env); break; // % case 7: op_eql(in, env); break; // == case 8: op_less(in, env); break;// < case 9: op_dup(in, env); break; // データスタックの先頭要素を複製 case 10: op_drop(in, env); break; // データスタックの先頭要素を破棄 case 11: op_swap(in, env); break; // データスタックの最初の二つの要素を入れ替え case 12: op_over(in, env); break; // データスタックの二番目の要素を先頭にコピーする case 13: op_rot(in, env); break; // データスタックの先頭三つの要素をローテーションする case 14: op_rpush(in, env); break; // データスタックの先頭要素を取り出しリターンスタックに追加する case 15: op_rpop(in, env); break; // リターンスタックの先頭要素を取り出しデータスタックに追加する case 16: op_rcopy(in, env); break; // リターンスタックの先頭要素をデータすタックに追加する case 17: op_jump(in, env); break; // 無条件分岐 case 18: op_jump_if(in, env); break; // 条件分岐 case 19: op_call(in, env); break; // 関数呼び出し case 20: op_return(in, env); break; // 関数から復帰 default: assert(false); } } private: typedef bytecode_stream bcs; typedef environment env; #define DPUSH(x) e.dstack().push_back(x) #define DPOP pop_back(e.dstack()) #define DNTH(nth) e.dstack()[e.dstack().size()-1-nth] #define RPUSH(x) e.rstack().push_back(x) #define RPOP pop_back(e.rstack()) #define RNTH(nth) e.rstack()[e.rstack().size()-1-nth] static void op_int(bcs& in, env& e) { DPUSH(in.read_int()); } static void op_add(bcs& in, env& e) { DPUSH(DPOP + DPOP); } static void op_sub(bcs& in, env& e) { int n = DPOP; DPUSH(DPOP - n); } static void op_mul(bcs& in, env& e) { DPUSH(DPOP * DPOP); } static void op_div(bcs& in, env& e) { int n = DPOP; DPUSH(DPOP / n); } static void op_mod(bcs& in, env& e) { int n = DPOP; DPUSH(DPOP % n); } static void op_eql(bcs& in, env& e) { DPUSH(DPOP == DPOP); } static void op_less(bcs& in, env& e) { DPUSH(DPOP > DPOP); } static void op_dup(bcs& in, env& e) { DPUSH(DNTH(0)); } static void op_drop(bcs& in, env& e) { DPOP; } static void op_swap(bcs& in, env& e) { std::swap(DNTH(0), DNTH(1)); } static void op_over(bcs& in, env& e) { DPUSH(DNTH(1)); } static void op_rot(bcs& in, env& e) { std::swap(DNTH(2), DNTH(0)); std::swap(DNTH(1), DNTH(2)); } static void op_rpush(bcs& in, env& e) { RPUSH(DPOP); } static void op_rpop(bcs& in, env& e) { DPUSH(RPOP); } static void op_rcopy(bcs& in, env& e) { DPUSH(RNTH(0)); } static void op_jump(bcs& in, env& e) { in.pc() = DPOP;} static void op_jump_if(bcs& in, env& e) { int p = DPOP; if(DPOP){ in.pc() = p;} } static void op_call(bcs& in, env& e) { RPUSH(in.pc()); in.pc() = DPOP; } static void op_return(bcs& in, env& e) { in.pc() = RPOP; } #undef DPUSH #undef DPOP #undef DNTH #undef RPUSH #undef RPOP #undef RNTH private: static int pop_back(stack_t& stack) { int x = stack.back(); stack.pop_back(); return x; } }; /** * バイトコード実行 */ class executor { public: void execute(const char* filepath) { bytecode_stream in(filepath); while(in.eos() == false) { octet opcode = in.read_octet(); op::call(opcode, in, env); } } const environment& get_env() const { return env; } private: environment env; }; } #endif
// ファイル名: pvm.cc // バイトコード実行用コマンド #include "pvm.hh" #include <iostream> void show(const char* name, const pvm::stack_t& stack) { std::cout << "[" << name << "]" << std::endl; for(int i = stack.size()-1; i >= 0; i--) { std::cout << " " << (stack.size()-1-i) << "# " << stack[i] << std::endl; } std::cout << std::endl; } int main(int argc, char** argv) { if(argc != 2) { std::cerr << "Usage: pvm BYTECODE_FILEPATH" << std::endl; return 1; } pvm::executor vm; vm.execute(argv[1]); const pvm::environment& rlt = vm.get_env(); show("data stack", rlt.dstack()); show("return stack", rlt.rstack()); return 0; }
;;; ファイル名: pvm-compile.lisp ;;; S式をVM用のバイトコードにコンパイル(アセンブル)する (defpackage pvm-compile (:use :common-lisp) (:nicknames :pvmc) (:export compile-to-file)) (in-package :pvm-compile) ;; 利用可能な操作(命令)のリスト (defparameter *op-list* '((1 :int) (2 :add) (3 :sub) (4 :mul) (5 :div) (6 :mod) (7 :eql) (8 :less) (9 :dup) (10 :drop) (11 :swap) (12 :over) (13 :rot) (14 :rpush) (15 :rpop) (16 :rcopy) (17 :jump) (18 :jump-if) (19 :call) (20 :return))) ;; 数値をリトルエンディアンのバイト列に変換する ;; n -> '(b1 b2 b3 b4) (defun int-to-bytes (n) (loop FOR i FROM 0 BELOW 4 COLLECT (ldb (byte 8 (* i 8)) n))) ;; 操作名に対するコード値を取得する (defun opcode (op) (assert #1=(find op *op-list* :key #'second)) (first #1#)) ;; コンパイル (defun compile-to-bytecodes (codes) (loop WITH unresolves = '() ; 未解決のアドレス参照 WITH labels = '() ; ラベルとアドレスのマッピング FOR code IN codes FOR pos = (length tmps) APPEND (etypecase code (integer `(,(opcode :int) ,@(int-to-bytes code))) ; 整数値構築 (keyword (list (opcode code))) ; 一般的な操作 (symbol (push `(,code ,pos) labels) ; アドレス(PC)参照用のラベル '()) (cons (ecase (first code) ; アドレス参照 (:addr (push `(,(second code) ,(1+ pos)) unresolves) `(,(opcode :int) 0 0 0 0))))) ; この時点では実際のアドレスが不明なので 0 を設定しておく INTO tmps FINALLY (let ((bytecodes (coerce tmps 'vector))) ;; アドレス解決 (loop FOR (label offset) IN unresolves FOR label-addr = (second (assoc label labels)) DO (setf (subseq bytecodes offset (+ offset 4)) (int-to-bytes label-addr))) (return bytecodes)))) ;; コンパイルして結果をファイルに出力する (defun compile-to-file (filepath assembly-codes) (let ((bytecodes (compile-to-bytecodes assembly-codes))) (with-open-file (out filepath :direction :output :if-exists :supersede :element-type '(unsigned-byte 8)) (write-sequence bytecodes out))) t)
*1:大別すると整数処理系、データスタック操作系、リターンスタック操作系、分岐系の四つ
fletとlabels
CommonLispのfletとlabels的なものを(あらかじめ使えるものはlambdaしかない状況で)自分で実装する必要が出てきたので、その際のメモ。
なお、以下では煩雑になるためfuncall呼び出しの記述を省略している(実際にはScheme処理系で動作確認を行っていた)。
let
flet、labelsの前にまずはlambdaを使ったletの実現方法を考える。
;; 以下のように変換可能 (let ((a 10) (b 20) (c 30)) (list a b c)) ↓ ((lambda (a b c) (list a b c)) 10 20 30)) ; => (10 20 30)
flet
上のようにしてletが使えると仮定した場合、fletと同じ機能を実現するのは簡単。
;; 単に変数に(lambda ...)を束縛すれば良い (let ((hello (lambda (x) (list 'hello x)))) (hello 'world)) ; => (HELLO WORLD)
labels
これがlabels(ローカル関数の再帰呼び出しが可能)になると少し難しくなる。
以下、fletと同様の方法で試した場合。
;; フィボナッチ数を計算 (let ((fib (lambda (n) (if (< n 2) n ;; fibの再帰呼び出し (+ (fib (- n 2)) (fib (- n 1))))))) (fib 10)) ; => ERROR: 再帰呼び出し部分でfib関数が見つからないと云われる
fib変数に束縛したlambdaの本体のコンテキストからは、fib変数が見つからないため、エラーとなる。
再帰呼び出しに使用するfib関数を明示的に引数を渡すようにすれば、問題は解決する。
(let ((fib (lambda (n fib) ; 第二引数に常にfib関数を渡すようにする (if (< n 2) n (+ (fib (- n 2) fib) (fib (- n 1) fib)))))) (fib 10 fib)) ; => 55
ただ、上の方法の引数の形が変わってしまうのが難点。
若干複雑にはなるが、以下のようにクロージャを使って再帰関数を持ち回すようにすれば、引数及び本体の形はほぼ変わらないので、マクロなどで生成するのは楽になる(ように思う)。
(let ((fib-rec (lambda (fib-rec) ; 再帰関数を引数に渡す (lambda (n) (let ((fib (fib-rec fib-rec))) ; 再帰関数の情報を埋め込んだfib関数を返す (if (< n 2) n (+ (fib (- n 2)) (fib (- n 1))))))))) (let ((fib (fib-rec fib-rec))) ; 再帰関数の情報を埋め込んだfib関数を返す (fib 10))) ; => 55
これでローカル関数の再帰呼び出しはできるようになったのでは、マクロを使ってシンタックスを整えれば、labelsが実現できることになる。
- -
以前に、何でCommonLispにはfletとlabelsの二つがあるのか、とかOcamlでletとlet recが分かれているか、とか少し疑問に思ったことがあったように思うけど、少し理由が分かった気がする。
マインスイーパー
端末上で動作するマインスイーパーをCommonLisp(SBCL)で実装してみた。
github: cl-mine-0.0.2
端末操作
端末操作部分のソースコードは以下のような感じ。
基本的には端末のエスケープシーケンスで(カーソル移動や画面クリア、文字色等の)制御を行っている。
ただ、キー入力をリアルタイムで取得可能にするのはエスケープシーケンスでは無理そうだったので、その部分はtcsetattr等のシステムコール(?)を使用している。
(defpackage console (:use :common-lisp :sb-alien) (:shadow :common-lisp format) (:export with-raw-mode clear move set-pos format newline formatln style)) (in-package :console) ;;; types ;;; (deftype direction () '(member :up :down :left :right)) ; カーソル移動の方向 (deftype color () '(member :black :red :green :yellow :blue :magenta :cyan :white :normal)) ; 文字色、背景色 ;;; constants ;;; (defparameter +ESC+ (common-lisp:format nil "~c[" (code-char #8r33))) ; エスケープシーケンスの開始文字列 (defparameter +STDIN_FD+ (sb-sys:fd-stream-fd sb-sys:*stdin*)) ; 標準入力のファイルディスクリプタ ;;; internal functions ;;; ;; 文字色のコード値を取得 (defun color-code (color) (declare (color color)) (ecase color (:black 30) (:red 31) (:green 32) (:yellow 33) (:blue 34) (:magenta 35) (:cyan 36) (:white 37) (:normal 39))) ;; cfmakeraw関数(キー入力リアルタイム取得用)はsb-posixパッケージに存在しないようなので読み込む (define-alien-routine ("cfmakeraw" %cfmakeraw) void (termios* (* t))) (defun cfmakeraw () (let ((termios (sb-posix::allocate-alien-termios))) (%cfmakeraw termios) (unwind-protect (sb-posix::alien-to-termios termios) (sb-posix::free-alien-termios termios)))) ;;; exported functions ;;; ;; 標準のformat関数の薄いラッパー (defmacro format (control-string &rest format-arguments) `(progn (common-lisp:format t ,control-string ,@format-arguments) (force-output))) ;; 改行付きのformat関数 (defmacro formatln (control-string &rest format-arguments) `(progn (format ,control-string ,@format-arguments) (newline))) ;; 改行: tcsetattr関数にcfmakerawの戻り値を渡した場合(rawモード?)、改行には #\Newlineと#\Return の両方が必要 (defun newline () (format "~c~c" #\Newline #\Return)) ;; 文字色、背景色、太字、下線、文字色背景色反転、等を指定した文字列を返す (defun style (x &key (color :normal) (bgcolor :normal) bold inverse underline) (declare (color color bgcolor)) (common-lisp:format nil "~a~{~d;~}~d;~dm~a~a0m" +ESC+ (remove nil (list (and bold 1) (and underline 4) (and inverse 7))) (color-code color) (+ (color-code bgcolor) 10) x +ESC+)) ;; 上下左右へのカーソル移動 (defun move (direction &optional (delta 1)) (declare (direction direction)) (when (plusp delta) (format "~a~d~a" +ESC+ delta (ecase direction (:up "A") (:down "B") (:left "D") (:right "C"))))) ;; 画面クリア。lineがtの場合はカーソル行のみをクリア。 (defun clear (&key line) (if line (format "~a2K" +ESC+) (format "~a2J" +ESC+))) ;; 任意の位置へのカーソル移動 (defun set-pos (x y) (format "~a~d;~dH" +ESC+ y x)) ;; 端末をrawモード(?)に切り替えてbodyを評価する (defmacro with-raw-mode (&body body) (let ((old (gensym))) `(locally (declare (sb-ext:muffle-conditions sb-ext:compiler-note)) (let ((,old (sb-posix:tcgetattr +STDIN_FD+))) (unwind-protect (locally (declare (sb-ext:unmuffle-conditions sb-ext:compiler-note)) (sb-posix:tcsetattr +STDIN_FD+ sb-posix:tcsadrain (cfmakeraw)) ,@body) (sb-posix:tcsetattr +STDIN_FD+ sb-posix:tcsanow ,old))))))
例えば、端末内をカーソル移動できるようにする場合は、以下のようなコードとなる。
;; 'e': ↑ ;; 'd': ↓ ;; 's': ← ;; 'f': → ;; 'c': exit (console:with-raw-mode (loop (case (read-char) (#\e (console:move :up)) (#\d (console:move :down)) (#\s (console:move :left)) (#\f (console:move :right)) (#\c (return)))))
簡単なUIならこれで十分かもしれない。
N-Queen: 高速化
こちらの記事に刺激を受けて、以前に実装したN-Queenを高速化してみた(Common Lisp版のみ)。
(defvar *fastest* '(optimize (speed 3) (safety 0) (debug 0) (compilation-speed 0))) (deftype max-board-size () '(mod #x100)) (declaim (inline check)) ; inline宣言を追加 (defun check (row queens &optional (r 1) &aux (q (car queens))) (declare #.*fastest* (max-board-size r row q)) (or (null queens) (and (/= q (+ row r) (- row r)) (check row (cdr queens) (1+ r))))) ;; dolistの亜種 ;; - リストの走査時に各要素を変数に束縛するのと同時に、走査中の要素を除いたリストも変数に束縛する ;; ※ 先頭要素は走査対象外 (defmacro dolist2 ((x but-x list) &body body) (multiple-value-bind (recur prev cur next) (values #1=(gensym) #1# #1# #1#) `(let ((,but-x ,list)) (labels ((,recur (,prev &aux (,cur (cdr ,prev))) (when ,cur (destructuring-bind (,x . ,next) ,cur (setf (cdr ,prev) ,next) (locally ,@body) (setf (cdr ,prev) ,cur) (,recur ,cur))))) (,recur ,but-x))))) #| ex: > (dolist2 (x but-x '(:head 1 2 3 a b c)) (print `(:x ,x :but-x ,but-x))) (:X 1 :BUT-X (:HEAD 2 3 A B C)) (:X 2 :BUT-X (:HEAD 1 3 A B C)) (:X 3 :BUT-X (:HEAD 1 2 A B C)) (:X A :BUT-X (:HEAD 1 2 3 B C)) (:X B :BUT-X (:HEAD 1 2 3 A C)) (:X C :BUT-X (:HEAD 1 2 3 A B)) --> NIL |# (defun n-queen (n) (declare #.*fastest* (max-board-size n)) (nlet-acc self (queens (rows (cons :head (loop FOR i FROM 0 BELOW n COLLECT i)))) (if (null (cdr rows)) ; rows == '(:head) (accumulate queens) (dolist2 (row rest-rows rows) (when (check row queens) (self (cons row queens) rest-rows))))))
erl-creole: ユニコード文字列とマルチバイト列の変換ライブラリ
少し必要になったのでErlangでユニコード文字列と各種エンコーディングのマルチバイト列(バイナリ)の相互変換を行うモジュールを作成した。
github: erl-creole-0.0.1
- UTF-8, Shift_JIS, CP932, EUC-JP, eucJP-ms, JIS(ISO-2022-JP), ISO-2022-JP-1
使用例
%% 入力文字列 > S = "Unicode (ユニコード) とは、世界中の多くのコンピュータ上の文字列を一貫した方法で符号化し、表現し、扱うためのコンピュータ業界の標準である。". %% EUC-JPに変換 > creole:from_string(S, eucjp). <<"Unicode (\æ\Ë\³¡¼\É) ¤È¤Ï¡¢À¤³釗Ãæ¤Î¿¤¯¤Î\³\ó\Ô\塼\¿¾å¤Îʸ»úÎó¤ò°ì´Ó¤·¤¿ÊýË¡¤ÇÉä¹æ²½¤·¡¢É½¸½¤·¡¢°·¤釗¤¿¤á¤Î\³\ó\Ô\å¡"...>> %% JIS(ISO-2022-JP)に変換 > Bin = creole:from_string(S, jis). <<"Unicode (\e$B%f%K%3!<%I\e(B) \e$B$H$O!\"@$3&Cf$NB?$/$N%3%s%T%e!<%?>e$NJ8;zNs$r0l4S$7$?J}K!$GId9f2=$7!\"I=8=$7!\"07$&$?$a$N"...>> %% バイト列からユニコード文字列に変換 > creole:to_string(Bin, jis). [85,110,105,99,111,100,101,32,40,12518,12491,12467,12540, 12489,41,32,12392,12399,12289,19990,30028,20013,12398,22810, 12367,12398,12467,12531,12500|...] > io:format("~ts~n", [creole:to_string(Bin, jis)]). Unicode (ユニコード) とは、世界中の多くのコンピュータ上の文字列を一貫した方法で符号化し、表現し、扱うためのコンピュータ業界の標準である。 ok %% 変換不能なバイト列がある場合は、デフォルトでは "?" が代わりに使用される > io:format("~ts~n", [creole:to_string(<<"Unicode (\e$B%~^s^sjaf*(asf7aK%3!<%I">>, jis)]). Unicode (??潁潁裃罟?癈羞疔コード ok %% "?"の代わりに"_"を使用 > io:format("~ts~n", [creole:to_string(<<"Unicode (\e$B%~^s^sjaf*(asf7aK%3!<%I">>, jis, creole:replace($_))]). Unicode (__潁潁裃罟_癈羞疔コード ok
*1:ユニコードと他のエンコーディングのコードポイントの対応は主に http://source.icu-project.org/repos/icu/data/trunk/charset/data/ucm/ を参考にさせてもらった。
文字列/バイト列用のハッシュ関数ライブラリ
A Hash Function for Hash Table Lookupに載っているハッシュ関数(Jenkins Hash)をCommon Lispで実装した。
github: jenkins-hash(0.0.2)
作成の主な動機は以下の二つ:
おそらくSBCL以外の処理系でも動くと思うけど、動作は未確認。
使用例
以下、使用例。
;;;; SBCL-1.0.51-64bit ;;; 【文字列】 ;; 文字列からハッシュ値を算出 (jenkins-hash:hash-string "ハッシュ関数") --> 3188986421 ; 一つのキーに対して二つのハッシュ値(32bit)を返す 2167986557 ;; パラメータ(seed1,seed2)を替えて別のハッシュ値を算出 (jenkins-hash:hash-string "ハッシュ関数" :seed1 13 :seed2 44444) --> 2402597428 3323692532 ;; 範囲指定 (jenkins-hash:hash-string "ハッシュ関数" :start 2 :end 4) --> 58741211 888923469 ;;; 【バイト列】 ;; バイト列からハッシュ値を算出 (jenkins-hash:hash-octets (sb-ext:string-to-octets "ハッシュ関数")) --> 1523938354 936250363 ;; sxhash関数だと配列を与えた場合、全て同じハッシュ値になってしまう (sxhash (sb-ext:string-to-octets "ハッシュ関数")) --> 518591303 (sxhash (sb-ext:string-to-octets "別の値")) --> 518591303 ;;; 【複数のハッシュ値】 ;; nth-hash関数を使って、任意個のハッシュ値を安価に生成可能 ;; ※ 内部的にはDoubleHashingを用いて生成している => 可算一つと乗算一つで算出可能 ;; 一つのキーに対する10個の異なるハッシュ値を取得する (defun hash10 (key) (multiple-value-bind (h1 h2) (jenkins-hash:hash-string key) ;; 最初の二つはそのまま使って、残りはnth-hash関数で生成する `(,h1 ,h2 . ,(loop FOR i FROM 2 BELOW 10 COLLECT (jenkins-hash:nth-hash i h1 h2))))) (hash10 "ハッシュ関数") --> (3188986421 2167986557 3229992239 1103011500 3270998057 1144017318 3312003875 1185023136 3353009693 1226028954)
N-Queen (Haskell + Common Lisp)
Etsukata blog: Haskellでlist monadを使ってN-Queens問題を解いてみました を見たのをきっかけに久しぶりにN-Queen問題を解くプログラムをHaskellで書いてみた。
---- ファイル名: nqueen.hs ---- コンパイル: ghc -O2 -o nqueen nqueen.hs # Glasgow Haskell Compiler, Version 7.0.3 import System -- クイーンの配置: リスト内のオフセットが列を、値が行を表す type Queens = [Int] -- N-Queenを解く: ボードのサイズを受け取り、全ての解答(可能な配置のリスト)を返す nQueens :: Int -> [Queens] nQueens n = solve n [] where solve 0 queens = [queens] -- 最後の列: 全てのクイーンを配置できた solve col queens = -- 途中の列: 全ての行に対して配置可能かを調べ、可能なら次の列に進む concat $ map (solve (col-1) . (:queens)) $ filter (check queens 1) [0..(n-1)] -- クイーンが配置可能かどうか調べる check :: Queens -> Int -> Int -> Bool check [] _ _ = True check (q:qs) r row -- rは対角線上の(チェックすべき)クイーンの位置を知るための変数 | q /= row && q /= row+r && q /= row-r = check qs (r+1) row | otherwise = False -- メイン関数 main = do args <- getArgs let size = (read $ head args)::Int let rlt = nQueens size putStrLn $ show . length $ rlt
実行結果:
$ ./nqueen 12 14200
処理時間
冒頭で挙げた記事のもの(Etsutaka)、および、Common Lisp版(後述)との処理速度の比較。
処理時間(サイズ=11) | 処理時間(サイズ=12) | 処理時間(サイズ=13) | |
---|---|---|---|
nqueen(Haskell:本記事) | 0.080秒 | 0.424秒 | 2.592秒 |
nqueen(Haskell:Etsutaka) | 0.132秒 | 0.736秒 | 4.424秒 |
nqueen(Common Lisp) | 0.071秒 | 0.375秒 | 2.289秒 |
この中ではCommon Lisp版が一番速くなっているけど、Haskellで効率の良いプログラムの書き方とかが全く分かっていないので、その辺を把握してちゃんと書けばHaskell版はもっと速くなるかもしれない。
Common Lisp版
Common Lisp版のソースコード。
内容的には N-Queen(1) - sileの日記 に最適化宣言を加えただけ。
(defvar *fastest* '(optimize (speed 3) (safety 0) (debug 0) (compilation-speed 0))) (deftype max-board-size () '(mod #x100)) (defun check (row queens &optional (r 1)) (declare #.*fastest* (max-board-size r row)) (or (null queens) (and (/= (the max-board-size (car queens)) row (+ row r) (- row r)) (check row (cdr queens) (1+ r))))) (defun n-queen (n) (declare #.*fastest* (max-board-size n)) (nlet-acc self (queens (col n)) (if (zerop col) (accumulate queens) (dotimes (row n) (when (check row queens) (self (cons row queens) (1- col)))))))
;; SBCL-1.0.51 > (n-queen 4) --> ((2 0 3 1) (1 3 0 2)) > (time (length (n-queen 12))) Evaluation took: 0.401 seconds of real time 0.400025 seconds of total run time (0.400025 user, 0.000000 system) [ Run times consist of 0.012 seconds GC time, and 0.389 seconds non-GC time. ] 99.75% CPU 800,068,094 processor cycles 13,926,400 bytes consed --> 14200