リリカル☆Lisp開発日記

久しぶりに新・ニコ動でLispを見てみたら、

数値比較したいです先生

というコメントがあったので、数値比較のための関数
=, <, >, <=, >=
を追加しました。

それから、階乗のプログラムを書く人が後を絶たないので、乗算も追加しました。
皆がどんなプログラムを試したかが残るというのはなかなか便利なものです。

comp.lang.lispのとある記事を見てて気づいたんですが、
(loop :until ... :do ...)
なんて書き方ができたんですね。
私は今まで
(loop :do ... :until)
のようなコードしか見たことがありませんでした。
当然、:untilだけでなく:whileでも同じようなことが出来るみたいです。

で、これらは同じ意味かと思ったら違うみたいです。

(loop :do (print 'oh!) :until t)
; OH!
; => NIL

(loop :until t :do (print 'oh!))
; => NIL

(macroexpand '(loop :do (print 'oh!) :until t))
; =>
; (MACROLET ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-ERROR)))
;  (BLOCK NIL
;   (LET NIL
;    (MACROLET ((LOOP-FINISH NIL '(GO SYSTEM::END-LOOP)))
;     (TAGBODY SYSTEM::BEGIN-LOOP
;      (PROGN (PROGN (PRINT 'OH!)) (WHEN T (LOOP-FINISH)))
;      (GO SYSTEM::BEGIN-LOOP) SYSTEM::END-LOOP
;      (MACROLET
;       ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-WARN)
;         '(GO SYSTEM::END-LOOP))))))))) ;
; T

(macroexpand '(loop :until t :do (print 'oh!)))
; =>
; (MACROLET ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-ERROR)))
;  (BLOCK NIL
;   (LET NIL
;    (MACROLET ((LOOP-FINISH NIL '(GO SYSTEM::END-LOOP)))
;     (TAGBODY SYSTEM::BEGIN-LOOP
;      (PROGN (WHEN T (LOOP-FINISH)) (PROGN (PRINT 'OH!)))
;      (GO SYSTEM::BEGIN-LOOP) SYSTEM::END-LOOP
;      (MACROLET
;       ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-WARN)
;         '(GO SYSTEM::END-LOOP))))))))) ;
; T

:doを先に書いた場合は、その内容が必ず1度は評価されるのに対し、
:whileや:untilを先に書いた場合はテストが先に行われるため、
:doの内容が評価されない場合もあるみたいです。

CLHSを眺めたところ、loopは基本的に書かれたとおりの順番に動くみたいです。
次のように気持ち悪いことも出来ます。

(loop :for i :from 0 :do (print i) :while (< i 3)  :collect i)
; 0
; 1
; 2
; 3
; => (0 1 2)

:whileを:collectより先に書いてあるので、リストに3は含まれません。
もちろん、:whileと:collectの順番を逆にすると、リストに3が含まれます。
loop恐るべし。

プログラミング Coqを参考に、CoqとCoqIDEを入れて試してみたが、
どうもCoqIDEの動きがおかしい。時々固まったり変な動作をする。
周りの人に相談したところ
「CoqIDEは使いものにならないからProof Generalを使え」
と言われたのでProof Generalとやらを入れてみた。
Emacs上で動く便利なものらしい。

以下はただのメモ書き。

* ダウンロード *
公式サイトからダウンロードする。
現時点のバージョンは4.0のようだ。

* インストール *
公式サイトの説明に従い、ファイルを展開して、
.emacsにload-fileを追加。

試しにEmacsで拡張子がvのファイルをひらいてみるが、
「Emacsのバージョンが23.1じゃないからダメ」
と怒られる。これまた公式サイトの説明に従いmake。

make clean
make compile EMACS=`which emacs`

しかし、make時にエラーが起こる。
「`font-lock-beginning-of-syntax-function’はobsoleteだから’syntax-begin-function’を使え」
と言ってるようなので、何も考えずにソースコード中の
font-lock-beginning-of-syntax-functionをsyntax-begin-functionに置換。
makeはこれで通った。

* 起動 *
Emacsで拡張子がvのファイルを開くと自動的にProof Generalが立ち上がる。
公式サイトのマニュアルを適当に眺めたところ、

• C-c C-nで証明をひとつ進める
• C-c C-uで証明をひとつ戻す

らしい。今の私の知識ではどうせこれしか使わない。後のものは後で覚えよう。

C-c C-RETでカーソルの位置まで証明を進めるみたいだが、
これをやろうとすると「C-c RET is undefined」と言われてしまう。
controlを押しながらreturnを押してるはずなんだけど、なんでだろう。
まあ、誰か詳しい人が解決法を教えてくれるだろう。

* 疑問点 *
CoqIDEでは「Eval simpl in xxx」みたいなものを、
専用の場所に書いていたけど、Proof Generalではどこに書けばいいんだろう。
ソース中に書いたら動いたけど、ソースとは分離したい。

前回に続いて、こんどはファイルのアップロード機能を付けました。

添付ファイルについて

セキュリティとか何も考えてないので結構怖いけど、
まあ、誰も使わないので今のところ大丈夫(?)でしょう。

前回とのdiffを貼っつけておきます。
Read the rest of this entry »

先日の日曜日、自転車で琵琶湖をまわってきました。
今年は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用紙全体を使うように調整するためのものです。
かなり大雑把ですが、それなりに見栄えがいいのでいいことにしてください。

おまけ:

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

KyotoWiLiKi

以下はdiffです。
(物好きな人は)ご自由にお使いください
Read the rest of this entry »

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

植木のまち池田

池田城

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

池田ァ！！！！！

全体のことはいけがみさんが書いてくれたので、
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のパーサは書いてないので、人間がパース済みの入力を与えるという、
素晴らしき作りになっています。

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

• Objective-Cの『遅さ』を計測したら、JavaやC++の5倍も遅かった: ニュースの社会科学的な裏側
• メソッド呼び出しループベンチにSmalltalkで参戦してみる: Smalltalkのtは小文字です

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

計測結果はこちら。

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

(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 ver1.4を公開しました。
今回の主な変更点は起動の高速化です。
結論から言うと、ver1.4はver1.3より約2.5倍も起動が速くなりました。

—

一見凄いことをしたように見えますが、
元のコードがシンボル生成の際にメモリを無駄に舐め回す、
アホな作りになっていただけ。ごめんなさい。
そこを普通のコード(?)に変えるだけで馬鹿みたいに速くなりました。

実は、その箇所を変更した時点で起動時間はver1.3の約9倍速くなりました。
しかし、「起動が速すぎてリリカルLispらしくない」という思いから、
なんとか起動時間を引き伸ばせないかと考え、
ver1.3以前ではフリーモードでしか使えなかった関数を、
どこでも使えるように修正しました。

フリーモードでしか使えなかった関数というのは、ここのcaar以下の関数です。
これらの関数はSchemeで書いてあり、
使うためにはまずそれらの定義を評価する必要がありますが、
残念なことに、それらの評価にはそれなりに時間がかかってしまいます。

ということで、ver1.3以前は起動時間のさらなる増加を避けるため、
起動時にはそれらの関数定義の評価を行わず、
フリーモードを動かしたときに評価を行うようにしていました。
しかし、今回起動時間が速くなったので、
ver1.4では起動時にこれらの関数定義の評価を行うよう変更しました。

これにより、起動時間が延びて安心
以前より多く関数が本編で使えるようになり便利になったはずです。

—

私の手元での起動時間 (10回計測の中間値)

—

また、地味な変更点として、シンボルのもつ文字列に対するGCの追加があります。
ver1.3以前では、シンボルを一度つくると、それの文字列は、
シンボル自体が回収されても放置されていたのですが、
今回、Copying GCでそれを回収するようにしました。
(Copying GCにしたのは、もとの実装を極力変更したくなかったため)
今のところシンボルを生成するような関数 (string->symbolなど) は提供していないので、
恐らくこのGCが呼ばれることはないでしょうが。

また作りました。

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

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

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