Archive for the ‘プログラミング’ Category

琵琶湖をPostScriptで描く

木曜日, 4月 21st, 2011

先日の日曜日、自転車で琵琶湖をまわってきました。
今年はAndroid端末 HTC DesireでMy Tracksというソフトを動かし、
GPSのログを記録しながら走ってみました。

で、せっかくなの、でそのログを使ってPostScriptで琵琶湖を描いてみました。

PDF
PostScript

なかなかいい感じに出来ました。
滋賀県民以外なら「これが琵琶湖の正確な形です」といっても騙せそうです。
(滋賀県民には「奥琵琶湖の形がおかしい」などとツッコまれそうだ。)

MyTracksは緯度経度のログをCSV形式で、出力することができるので、
それをCommon Lispで読み込み、PostScriptに変換という流れで作りました。
変換につかったプログラムは以下のとおりです。

(defun skip-elms (stream n)
  (when (char= (peek-char nil stream) #\,)
    (read-char stream))
  (dotimes (i n)
    (unless (char= (peek-char nil stream) #\,)
      (read stream))
    (assert (char= (read-char stream) #\,))))

(defun read-latlon (line)
  (let (lat lon)
    (with-input-from-string (s line)
      (skip-elms s 2)
      (setf lat (read-from-string (read s)))
      (skip-elms s 0)
      (setf lon (read-from-string (read s))))
    (values lat lon)))

(defun convert-latlon (lat lon)
  (values (+ 50 (* (- (* lat 111) 3881) 11))
          (+ 50 (* (- (* lon 91) 12363) 11))))

(defun doit ()
  (with-open-file (s "biwa.csv")
    (with-open-file (out "biwa01.ps" :direction :output :if-exists :supersede)
      (write-line "%!" out) (write-line "gsave" out)
      (dotimes (_ 3611)
        (read-line s))
      (do ((i 3612 (1+ i)))
          ((>= i 30334) t)
        (multiple-value-bind (lat lon)
            (multiple-value-call #'convert-latlon
              (read-latlon (read-line s)))
          (if (= i 3612)
              (format out "~A ~A moveto~%" lon lat)
              (format out "~A ~A lineto~%" lon lat))))
      (format out "stroke~%showpage~%grestore"))))

マジックナンバーがたくさん出てますが、
書き捨てのプログラムなので気にしない方針で。
convert-latlonは緯度経度をPostScriptの座標(ポイント)に変換します。
数111は緯度1度あたりのおおよその距離(km)、
数91は経度1度あたりのおおよその距離(km)、
あとの数はA4用紙全体を使うように調整するためのものです。
かなり大雑把ですが、それなりに見栄えがいいのでいいことにしてください。

おまけ:

WiLiKiにアクセス制御機能を付けた

土曜日, 4月 16th, 2011

説明するより実物を見たほうが早いでしょう。

KyotoWiLiKi

以下はdiffです。
(物好きな人は)ご自由にお使いください
(さらに…)

関西Coders 第一回ミーティング

金曜日, 4月 15th, 2011

4月9日に大阪府池田市某所にて、怪しげな集会に行ってきました。

植木のまち池田

池田城

インスタントラーメン発明記念館

池田ァ!!!!!

               __, . : ´  ̄ ̄ ` 、
        、__, . :´: : : : : : : : : : : : : : : : : . ヽ
        \` < . : : : : : : : : : : : : : : : : : : : : : .\
         \  `ヽ、: : : : : : : : : : : : : : : : : : : : : .\
          八_≦=\: : : : : / . : __: : : : : : : . ヽ
        / .: : : : : : : : : : : / . : /   //l : : : : : : . l\
       / .: : : : : : : : : : / \/     l/  |ノ ヽ: : : : :|: . ヽ
      / .: /: : : : : : : : /\_/`\           | : : : :|: : : . \_
    _/ .:// : : : :/⌒V. :/`ヽ ノ ̄ ̄`ヽ、―ニ 二三
    ̄ ̄ / : :/lハ  /: /`ヽ / ´`ヽ _  三,:三ー二二   
         |: :/  l : :/ /   ノヽ–/ ̄ ,    ` ̄ ̄ ̄ ̄
        ∨   | :/ ∧⊂⊃ミ }  …|  /!ヘ;;;;丿
      ___ /Ⅳ//∧   _}`ー‐し’ゝL _
     // ̄\\ |ノ ̄\ヽ    ヘr–‐‐’´}    ;ー——–
    〃 ̄\ \\    \\   ヾ:::-‐’ーr‐'”==-──
   〃    \ \\    ヽ ` / ̄厂`丶、__     レ′
  〃      \ \\    l__/     // ∧
 //        \ >ー 、 |  /    // / l

全体のことはいけがみさんが書いてくれたので、
Prologで書いたML(のサブセット)のインタプリタ(?)の話でも書いておきます。


こんな感じの推論規則を元に、

rule(['|-', Env, I, evalto, I], [], 'E-Int') :- env(Env), i(I).
rule([I1, plus, I2, is, I3], [], 'B-Plus') :-
  i(I1), i(I2), I3 is I1 + I2.
rule(['|-', Env, [if, E1, then, E2, else, E3], evalto, V],
     [['|-', Env, E1, evalto, true],
      ['|-', Env, E2, evalto, V]], 'E-IfT') :-
  e(E1), e(E2), e(E3), env(Env).

こんな感じの述語を定義して、

infer(X, [X, by, Name]) :-
  rule(X, [], Name).
infer(X, [X, by, Name|Z]) :-
  rule(X, Y, Name), infer_list(Y, Z).
infer_list([], []).
infer_list([X|Xs], [Y|Ys]) :- infer(X, Y), infer_list(Xs, Ys).

推論規則を次々つかってやる述語を定義すると、

% 心の目で "if true then 1 + 2 else 0 => X" とお読みください
?- infer(['|-', [], [if, true, then, [1, +, 2], else, 0], evalto, X], Z), output(Z).
|- if true then 1 + 2 else 0 evalto 3 by E-IfT {
  |- true evalto true by E-Bool {};
  |- 1 + 2 evalto 3 by E-Plus {
    |- 1 evalto 1 by E-Int {};
    |- 2 evalto 2 by E-Int {};
    1 plus 2 is 3 by B-Plus {}
  }
}
X = 3,
Z = [...]

式の値を求めた上で証明木を書いてくれるというものです。
(証明木は

 A B
----- RULE
  C

C by RULE {
  A;
  B
}

と記述しています)

一応、型推論やら継続の取り扱いなどもできます。
大学院の講義で「導出を書け」という課題があったため作ったもので、手抜きです。
MLのパーサは書いてないので、人間がパース済みの入力を与えるという、
素晴らしき作りになっています。

型宣言とかメソッドのディスパッチとか

木曜日, 3月 3rd, 2011

2週間ほど前、複数のプログラミング言語(処理系)でメソッドの起動時間を比べるという、
エントリが一部で盛り上がっていたらしいです。

既ににいろいろな言語で計測が行われているので、元のエントリとは趣向を変えて、
Common Lispのみについて、書き方による速度の変化を見てみました。
計測にはMac Book (Core 2 Duo 2GHz)で SBCL 1.0.44を使用しました。

計測結果はこちら。

元のプログラム 20.43 秒
型宣言を追加 14.897 秒
総称関数を普通の関数に変更 8.179 秒
インスタンスをクロージャに変更 3.558 秒
スペシャル変数を使用 3.805 秒

元のプログラムはこれです。

(defclass looping () ((n0 :initform 0 :accessor n0-of)))

(defmethod calc ((self looping) (n integer))
   (let ((n1 (+ (n0-of self) (- 1 (* 2 (mod n 2))))))
      (setf (n0-of self) n)
      n1))

(let ((l (make-instance 'looping)) (n 1) (t1 (get-internal-real-time)))
   (dotimes (c 268435455)
      (setq n (calc l n)))
   (print (float (/ (- (get-internal-real-time) t1) internal-time-units-per-second))))

手始めに型宣言を付けました。

(defclass looping () ((n0 :initform 0 :accessor n0-of :type fixnum)))

(defmethod calc ((self looping) (n integer))
  (declare (optimize (safety 0) (speed 3)))
  (declare (fixnum n))
  (let ((n1 (the fixnum (+ (the fixnum (n0-of self)) (- 1 (* 2 (mod n 2)))))))
    (declare (fixnum n1))
    (setf (n0-of self) n)
    n1))

型をfixnumに固定するだけで結構速くなります。

次に、defmethodをdefunに変更。

(defun calc (self n)
  (declare (optimize (safety 0) (speed 3)))
  (declare (fixnum n))
  (declare (looping self))
  (let ((n1 (the fixnum (+ (the fixnum (n0-of self)) (- 1 (* 2 (mod n 2)))))))
    (declare (fixnum n1))
    (setf (n0-of self) n)
    n1))

元のエントリの趣旨から完全に外れてしまった感じですが、
ディスパッチが不要になるとかなり速くなります。

本来の趣旨からどんどん離れてクロージャとか使っちゃいます。

(let ((self 0))
  (declare (fixnum self))
  (defun calc (n)
    (declare (optimize (safety 0) (speed 3)))
    (declare (fixnum n))
    (let ((n1 (the fixnum (+ (the fixnum self) (- 1 (* 2 (mod n 2)))))))
      (declare (fixnum n1))
      (setf self n)
      n1)))

(time (let ((n 1) (t1 (get-internal-real-time)))
        (dotimes (c 268435455)
          (setq n (calc n)))
        (print (float (/ (- (get-internal-real-time) t1) internal-time-units-per-second)))))

めちゃくちゃ速くなりました。

最後に、クロージャすら使わずにスペシャル変数を使いました。

(defvar *self* 0)
(declaim (fixnum *self*))
(defun calc (n)
  (declare (optimize (safety 0) (speed 3)))
  (declare (fixnum n))
  (let ((n1 (the fixnum (+ (the fixnum *self*) (- 1 (* 2 (mod n 2)))))))
    (declare (fixnum n1))
    (setf *self* n)
    n1))

意外なことに、クロージャ版より遅くなってしまいました。
ダイナミックスコープに備え、なにか面倒なことをしてるんでしょうか。

もっと速くする方法を知ってる方がいましたら、ぜひとも教えてください。

新・ニコ動でLisp

土曜日, 2月 12th, 2011

また作りました。

コメントにあるとおり、ニワン語(ニコニコ動画上のスクリプト言語)の仕様変更のため、
以前作ったものがまともに動かなくなってしまいました。
なんとか動くようにと頑張ってみたんですが、途中で力尽き、
「これはもう、一から作り直したほうが早いんじゃないのか?」
と思い、作り直したという流れです。

ニワン語もいつの間にか使いやすくなったもので、
たったの50行ほどで書けてしまいました(ソースはこちらから)。
しかし、相変わらずよく分からない挙動をすることがあり、苦労します。
今回、ダイナミックスコープになっているのは、その妙な挙動に悩まされたためです。
最初はレキシカルスコープでつくっていたんですが、
環境の書き換えを(配列を破壊的に書き換えることにより実現)するところで、
何故か変数が壊れたり変な動作をしたり、変な動作をするようになりました。
私のプログラムが悪いのじゃないかと思い、
数時間に渡るデバッグをしたものの原因は分からず。
配列の書き換えを避けるためにダイナミックスコープにしたという訳です。
(変数の参照先は書き換えるが、配列自体は書き換えない。ソース中のgenvを参照)
スコープ以外の仕様は以前のものとほぼ同じです。

**NewNicoLisp 仕様**
<サポートする関数>
car
cdr
cons
eq (数の比較もこれで行う)
atom
+ (引数は任意個)
– (引数は2つ)
eval
<サポートするスペシャルオペレータ>
quote
if
progn
lambda
defun
<データ>
シンボル (日本語なども使用可能)
数 (入力時は非負整数のみ)
コンス (今のところはimmutable)
その他 (SUBR、FSUBR、EXPR)
<リーダ>
quoteのリーダマクロあり
ドット記法の入力は未対応
<スコープルール>
ダイナミックスコープ

長さの情報を持つ配列型とか

日曜日, 1月 16th, 2011

Common Lispでは変数の型を明示的に指定することができます。

(defun a3 (x)
  (declare (type (array * (3)) x))
  x)

こう書くと、関数a3の引数xの型は「長さ3の配列」という意味なります。
これをSBCLで動かしてやると

(a3 123)  ;=> ERROR
; The value 123 is not of type (VECTOR * 3).

このように型の違うものでa3を呼び出すとエラーを検出できます。
このエラーの検出は実行時に行われています。
そのため、関数を挟むと、その関数を呼び出すまでエラーを検出できません。

;;; a3に整数を渡す関数
(defun f1 (x)
  (declare (type integer x))
  (a3 x))  ;=> 問題なく動作 (エラーを検出できない)

こうなってしまう原因は「xの型は長さ3の配列である」という情報が、
関数a3の内側にしか伝えられないためです。
declaimを使ってa3の型を外側に伝えてやることで、この問題は解決できます。

(declaim (ftype (function ((array * (3))) t) a3)
(defun a3 (x)
  (declare (type (array * (3)) x))
  x)

(defun f1 (x)
  (declare (type integer x))
  (a3 x))  ;=>
; caught WARNING:
;   Asserted type (VECTOR * 3) conflicts with derived type
;   (VALUES INTEGER &OPTIONAL).

コンパイラが型がおかしいことをちゃんと伝えてくれました。
これで「コンパイル時に型チェックが入る言語以外でプログラムを書きたくない」
という人も安心してCommon Lispが使えます。

安心したところでもう少しプログラムを書いてみます。

(declaim (ftype (function (array) t) a*))
(defun a* (x)
  (declare (type array x))
  (a3 x))

引数に配列をとる関数a*を定義しました。
a*の引数は「配列」というだけで、長さは指定していません。
しかし、a3の呼び出しに対して(SBCLでは)警告が出されることはありません。
それでは、a*を使ってみます。

(a* (make-array 3 :initial-element 999))  ;=> #(999 999 999)
(a* 123)  ;=> ERROR
; The value 123 is not of type ARRAY.
(a* (make-array 4 :initial-element 999))  ;=> ERROR
; The value #(999 999 999 999) is not of type (VECTOR * 3).

a*に配列以外を渡すと、a*に怒られ、
a*に長さ3以外の配列を渡すと、a3に怒られます。
しかし、(SBCLでは)コンパイル時に前者しか検出できません。

;;; a*に整数を渡す関数
(defun f2 (x)
  (declare (type integer x))
  (a* x))  ;=>
; caught WARNING:
;   Asserted type ARRAY conflicts with derived type (VALUES INTEGER &OPTIONAL).

;;; a*に長さ4の配列を渡す関数
(defun f3 (x)
  (declare (type (array * (4)) x))
  (a* x))  ;=> 問題なく動作 (エラーを検出できない)

なんということでしょう。ちょとガッカリな結果です。
この結果を利用して、非常に残念な関数を定義できます。

(declaim (ftype (function ((array * (4))) t) a4)
(defun a4 (x)
  (declare (type (array * (4)) x))
  (a* x))

この関数a4は「長さ4の配列」を受け取る関数なので、
長さ4の配列以外を渡すと怒られます。
しかし、a4は最終的にa3を呼び出すので、
長さ3の配列を渡さないと怒られます。
つまり、どんなものを渡しても怒られるというわけです。

C言語(GCC)も似たような動きをします。

int a[3], (*p)[3], (*q)[], (*r)[4];
p = &a;
r = q = p;

長さ不定の配列へのポインタを中継することで、
長さ3の配列のアドレスを長さ4の配列へのポインタに代入できてしまいます。
ちなみに、C++(G++)だとコンパイルエラーになります。
G++といえば、

class C1 {} c1;
class C2 { int a[0]; } c2;

このようなクラスを作ったときに、
sizeof(c1) > sizeof(c2)が成立するおもしろ言語なのに生意気です。

またBiwaSchemeでゲーム作った

火曜日, 12月 21st, 2010

またBiwaSchemeでゲームを作りました (以前作ったのはこれ) 。
Internet Explorer以外のまともなブラウザなら多分動作します。

Hockey in BiwaScheme

画面右の “open” をクリックすると、BiwaSchemeの対話環境が表示され、
そこに式を打ち込んで “eval” を押すことで変数の値を書き換えたり、
手続きの定義を書き換えることができます。
最初は、テキストボックスに “(set! ball-vy -10)” が入っており、
この状態で “eval” をクリックすると、ボールが勢い良く上に飛んでいきます。

実はこれ、以前Erlangで作ったゲームをそのまま移植しただけです。
Erlangで書いたときは通信対戦をできるようにしていたので、
今回のBiwaScheme版でもTupleSpaceを使って何とかできないか、
と挑戦はしてみたものの、うまくいかなかったため、
泣く泣く通信対戦の機能は削ってしまいました。

#+のちょっといい話

火曜日, 7月 13th, 2010

Lispでは式1個だけをコメントアウトしたいことがよくあります。

(list A B C)

このようなプログラムで、Bをコメントアウトするときに、
行コメントをつかうと非常に不格好になります。

(list A ;B
  C)

ブロックコメントコメント #| … |# を使えばもう少し奇麗に書けますが、面倒です。

(list A #|B|# C)

Schemeの場合、R6RSで式コメントが書けるようになりました。

(list A #;B C)

非常に簡潔です。素晴らしい。

Common Lispで同じことをする場合、#+を使います。
#+はCで言うところの#ifdefであり、環境に依存するコードを書くときによく使います。

(defun do-something-quickly()
  #+allegro ACL専用の処理
  #+sbcl SBCL専用の処理
  #+clisp CLISP専用の処理
  #-(and allegro sbcl clisp) (error "Use ACL, SBCL or CLISP.")
)

#+X Yと書くと、(member X *features*)が真であれば、Yがリードされ、
偽であればYは読み飛ばされます。
*feature*に含まれないシンボルXをわざと書けば、式コメントが実現できます。

;; 例1
(list A #+nil B C)
;; 例2
(list A #+ignore B C)
;; 例3
(list A #+comment B C)

多くの場合、上の3つの例はうまく動いてくれますが、
万が一、*feature*にnilやignoreやcommentが含まれている場合、Bがコメントアウトされません。

どうしたものかと思いつつ、ずっと #+nil を使い続けていたんですが、
どんな環境でも確実にうまくいく方法を見つけました。

(list A #+(or)B C)

#+(or)です。
#+(or X Y …) Zと書くと、
(or (member X *features*) (member Y *features*) …)
が真のときのみ、Zがリードされます。
つまり、orに引数を与えなければZは常にリードされません。
これで、*features*にnilが含まれていないか心配で眠れない夜ともおさらばです。

##のわりとどうでもいい話

火曜日, 6月 8th, 2010

※リストの循環は脳に悪影響を及ぼす可能性があります。
 本エントリを読むときは必ず(setq *print-circle* t)を利用して下さい。

<括弧を書かずに循環構造をつくろうとしたのがことの始まりでした>

'#1='#1# => #1='#1#

リーダマクロ ‘ を展開すると結果は、 #1=(quote #1#) になり、循環構造ができます。
しかし、CLISPでこれのcdrを取るとスタックオーバフローします。

(cdr '#1='#1#)
*** - Program stack overflow. RESET

ちなみに、SBCLだとちゃんと結果が表示されます。

(cdr '#1='#1#) => (#1='#1#)

<ちゃんと!?>
よくよく見ると、微妙におかしなことに気づきました。
#1=(quote #1#)は2個のコンスセルから構成されます。
しかし、(#1=’#1#)は3個のコンスセルから構成されてるじゃないですか!
(cdr ‘#1=’#1#)は#1=((quote . #1#))じゃないとおかしいはず(図参照)。

<何かがおかしい>
もし(#1=’#1#)が図の右側のような構造で表されていた場合、
(#1=’#1#)と(cdar (#1=’#1#))は別のものになるはずです。しかし、

(defvar a (cdr '#1='#1#)) => A
a => (#1='#1#)
(eq a (cdar a)) => T

同一のものと判定されてしまいました。
しかし、

(defvar b '(#1='#1#)) => B
(eq b (cdar b)) => NIL

やっぱり同一じゃなかった!?
つまり、ここから得られる結論は
(#1=’#1#)は(#1=’#1#)であって(#1=’#1#)ではない、なんじゃそりゃ。

<更なる謎>
CLISPで色々試していると更に訳の分からないことが起きました。

(cdr '#1=(quote #1#))
*** - Program stack overflow. RESET
(cdr '#1=(q #1#)) => #1=((Q . #1#))

quoteだと駄目で、qなら大丈夫!?
シンボルが別のものになっただけで、なんで結果が変わるのでしょうか。

<それでもGaucheなら・・・Gaucheならきっと何とかしてくれる>
もうCommon Lispの処理系に頼るのに嫌気がさして来たのでGaucheを使ってみました。

'#1='#1# => #0='#0#

Gaucheだと##は0から始まるみたいです。で、これのcdrをとると

(cdr '#1='#1#) =>
#0=('''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''
(中略)
'''''''''''''''''''''''''''''''''''''''''''
Segmentation fault

やたらと沢山の引用符が出た後に死んでしまいました。

ここまで来てやっとすべての謎が解けました。
CLISPがスタックオーバフローを起こした原因は(恐らく)この引用符です。
表示部分で(quote X)を’Xに変換する処理が素直であったために死んでしまったのでしょう。

一方、素直でない(?)SBCLは生き残ることに成功しましたが、
(#1=’#1#)という表示と(#1=’#1#)という入力が別物になるという問題が生まれてしまいます。
個人的にはLispWorksの動作が一番好きです。

with-open-fileをC++/C99で

木曜日, 6月 3rd, 2010

Common Lispにはwith-open-fileというマクロがあります。

(with-open-file (stream filename)
  ...
  (read-line s)
 ...
 )

このマクロは、ファイルをオープンして、
ここを抜けるときに自動的にファイルをクローズしてくれるというものです。
そのため、ファイルの閉じ忘れがおこりません。

このマクロをC++、もしくはC99で再現する方法を思いついたのでメモしておきます。

#define with_open_file(s,p,m) \
  for(FILE *s=fopen(p,m); s; fclose(s),s=NULL)
...
void hoge(char *path) {
  char buf[256];
  with_open_file(fp, path, "r") {
    ...
    fgets(buf, sizeof(buf), fp);
    ...
  }
}

短いコードでなかなかいい感じだと思います。
残念ながら、本物のwith-open-fileと異なり、returnなどで関数を抜けたときに、
ファイルを閉じてくれないという問題がありますが。
(その他にも、breakやcontinueを中で使ったらまずいとか、色々あるけど、
まあ、一発ネタなんで、深いことは考えないことにします。)