第1章 さあ、始めよう

1章のコードはcode/src/examples/introduction.cljにある。

1.1 なぜ Clojure なのか

Javaとの比較で高階関数を使うことでコードが簡潔に書けることを主張する。マクロの存在も匂わせている。他のLispよりも括弧が少ないというのは視覚上のメリットとS式単位の編集がやりにくくなるというデメリットがあると思う。

1.2 Clojure を書き始めよう

REPLの使い方と関数定義、状態の取扱いについて。セットやリファレンスが何かを説明せずに使いはじめているのは面喰らう構成だ。後でちゃんと説明があるのだろう。
リファレンスというデータ構造があって、その中に値を格納し、参照や変更には専用の関数を必要とする程度に思っておく。

1.3 Clojure ライブラリの探索

CLと同じようにrequireやuseできる。useがCLのuse-packageに相当する。名前衝突してもエラーを出さずに上書きしてしまうらしい。これは微妙に怖い仕様だ。プロジェクトの定義などをすっ飛ばしているけどこれも後でちゃんと説明があるのだろう。
docはCLのdocumentationに相当する。CLの場合は(documentation name-symbol 'function)のように関数の名前空間なのか変数の名前空間なのか指定する必要があったが、ClojureLisp-1なので(doc name-symbol)とするだけでいい。(find-doc "string")や(apropos "string")を使って関数を探す感じか。

プログラミングClojure第二版を買ったので環境づくり

オーム社のページからプログラミングClojure第二版(電子版)を買ってみた。

第二版からはプロジェクト管理ツールleiningenを使うようになったのでこれをインストールする必要がある。とはいえシェルスクリプトに実行権限を与えて実行パスの通ったディレクトリに置くだけである。
サンプルコードにはproject.cljが入っていて、ここに依存するパッケージやClojureのバージョン(1.3.0)が指定してある。依存ライブラリのバージョンまで指定されているので、確実にサンプルコードを動かすことができる。第一版でサンプルコードがまともに動かずに苦しんだ自分にはありがたい。

サンプルコードのルートディレクトリまで移動して

$ lein deps

と入れるだけで必要なファイルがすべて自動的にダウンロードされる。

次に編集環境を作る必要がある。Emacsは入ってるとして、clojure-mode.elnrepl.elは自分で入れる必要がある。最近はEmacsにパッケージマネージャpackage.elが標準で付いてくるのでここからインストールする方法もある。.emacsに以下のコードを追加して、

;; Marmaladeの為の設定
(require 'package)
(add-to-list 'package-archives 
    '("marmalade" .
      "http://marmalade-repo.org/packages/"))
(package-initialize)

M-x package-refresh-contents [RET] をやることでレポジトリが更新される。その後に M-x package-install とやって、パッケージ名を入力すると、関連するファイルがダウンロード、バイトコンパイルされ、~/.emacs.d/elpa/ にインストールされる。
パッケージ名としてnrepl.el、clojure-modeと入れれば依存ライブラリも含めてまとめてインストールされる。


自分はgit cloneでソースをダウンロードして.emacsからrequireするようにした。nrepl.elはSLIMEほどきめ細かではないにせよ、leiningenとの連携を考えて作ってあるらしい。

Emacsでサンプルコード中のproject.cljを開いて、 M-x nrepl-jack-in と入れるとREPLが起動する。念のためバージョンを確認するとちゃんと1.3.0になっている。

user => (clojure-version)
"1.3.0"

これで環境構築はできた。

Weblocksでウィジェットのスロットを変更すると即座に反映される件

以前weblocksのwith-flowマクロを使ってウィジェットを置き換えるという記事を書いたが、別のウィジェットに置き換えるのではなく、同じウィジェットのスロットを変更してそれを反映させたい場合はどうするのだろうかという疑問が湧いたので実験してみた。

まずは2つのウィジェットを定義する。一つは変更対象のウィジェットrerender-testで、もう一つは変更を実行するリンクを表示するウィジェットrerender-updateだ。rerender-updateはrerender-testのインスタンスを参照するためのスロットを持っている。

(defwidget rerender-test ()
  ((body :accessor body-of :initarg :body)))

(defwidget rerender-update ()
  ((rerender-test-widget :accessor rerender-test-widget-of :initarg :rerender-test-widget)))

次に、これらのウィジェットがどのように表示されるかを定義する。rerender-testはbodyスロットに入っている文字列を単に表示するだけだ。rerender-updateはrerender-testスロットに入っている変更対象のウィジェットのbodyスロットを変更するリンクを表示する。

(defmethod render-widget-body ((widget rerender-test) &rest args)
  (declare (ignore args))
  (with-html
    (:p (str (body-of widget)))))

(defmethod render-widget-body ((widget rerender-update) &rest args)
  (declare (ignore args))
  (render-link
   (lambda (&rest args)
     (declare (ignore args))
     ;; ウィジェットのスロットを変更するだけで反映される
     (setf (body-of (rerender-test-widget-of widget)) "After update"))
   "update"))

ここまで定義した二つのウィジェットを子に持つ親ウィジェットインスタンスを作る関数make-rerender-testを定義し、init-user-sessionの中で呼び出す。

(defun make-rerender-test ()
  (let ((rerender-test-w (make-instance 'rerender-test :body "Before update")))
    (make-instance 'widget
       :children (list rerender-test-w
		       (make-instance 'rerender-update :rerender-test-widget rerender-test-w)))))

(defun init-user-session (root)
  (setf (widget-children root)
	(list (make-rerender-test))))

このWebアプリケーションをブラウザから見ると以下のようになる。

ここでupdateと表示されているリンクを押すと、以下のように変わる。

明示的にウィジェットの再描画を指示していないにも関わらず、rerender-testのスロットが変更されればその結果が自動的に反映されることが分かる。テーブルにレコードを追加するときなどに便利そうだ。
with-flowによるフロー制御されたウィジェットの置き換えと、ウィジェットのスロットの変更による再描画で、WebアプリのUIはほとんど構築できるのではないかと思う。

スキャナと裁断機をレンタルして自炊した全記録

十年以上買い集めてきたので、流石に本がたまってきたと感じていた今日このごろ。優に100冊くらいはあるだろうか。
しかも大半は技術書なのでかさばる。かさばる本は出し入れや持ち運びが大変なので結局読まなくなる傾向にあった。
読む機会を増やすには、手軽に持ち運べる状態にすることが肝要と思い、スキャンして電子化することにした。

機材をレンタル

今後新たに買う本は極力電子版を買うとして、今ある紙の本をスキャンできればそれでいい。そのためスキャナや裁断機はレンタルでかまわない。レンタル業者にはスキャレンを選んだ。この場合スキャナはPFU ScanSnap S1500になる。
レンタルの申し込みの際には現住所を証明する書類が必要になる。自分の場合はNTTの請求書をデジカメで撮影して申し込みフォームで添付した。
料金は送料を含めると一週間レンタルするコースで7000円程度。PayPalからクレジットカードで決済する。
申し込んでから一週間ほど経ってからスキャナと裁断機が送られてきた。

ダンボールを開封したところ。中にはスキャナと裁断機、スキャナのマニュアルとドライバのCD、ケーブルなどが入っている。全部で20kg以上あるので腰を痛めそうになる。

裁断機を取り出したところ。でかい。重い。

スキャナのセットアップをしたところ。思ったよりコンパクトである。

きれいに裁断するためには、事前に100枚ぐらい単位で本を解体する必要がある。カッターで本を二つに分けたところ。

背表紙から十分マージンを取っておかないと糊が残ってスキャナが詰まるので後で苦労する羽目になる。

スキャナについて。SnacSnap S1500には一度に50枚ぐらいまでしか入らないので、何度も細かく手差しする必要がある。これがかなり面倒臭かった。読み取るスピード自体は速く、分速20枚くらいで読み込む。カラーではOCRが働かないので、カラーの本でも涙を飲んで白黒でスキャンした。白黒であればスーパーファイン画質(600dpi)でも300ページの本で20MBほどですむ。これがカラーだと5〜10倍くらいにはなるから驚きだ。このぐらいのサイズであればNexus7でもサクサク見られる。本文内検索のためにはスキャン後にOCR処理が必要になる。これは時間がかかるので寝てる間や、スキャナ返却後に後回し。なにしろ一週間しかないのだから。

結局、全部の本をスキャンするには丸二日くらいはかかった。ゴールデンウィークなどのまとまった時間がないときつい作業である。手間を考えると、裁断ブックマートのように、裁断だけを代行してくれる業者を利用し、スキャナだけをレンタルないし購入するというのがいいかもしれない。ユーザからしてみれば自炊全体を代行してくれる業者が一番ありがたいが、現行法ではスキャン作業は本人がやらないと私的複製にならないという。

そしてスキャン後の本の残骸。

十年以上かけて集めてきた本を捨てることに対しては一抹の寂しさもあったが、このまま置いておいても邪魔すぎるので古紙の日に一思いに捨てた。
スキャナと裁断機は元のダンボールに収めて、着払いでレンタル業者に送り返す。返送のための送り状も入っているので、それを貼るだけである。ヤマトのWebサイトから集荷依頼を出して、引き渡して終わり。

その後

PDFはDropboxで管理することにした。Nexus7との同期も簡単。

A4の本でも横にすれば普通に読める。

感想

前述した通り、スキャナに一度に入れられる枚数が少ないので常にスキャナに張り付いていなければならないなど、拘束時間が長い。自分の人件費のことも含めて考えると、自炊代行が認められるならばそれが一番であろうと思う。
最近では自炊代行業者に著作権使用料を納めさせることで自炊代行を認めるという動きもある。
「自炊」代行を認めるルール作りへ、作家など「Myブック変換協議会」設立
ソニー著作権保護機能に拘ったためiPodに負けたとも言われる。CCCDも結局は売れなかった。どのような形であれ、著作権を守るためにユーザの利便性を犠牲にしてしまっては、そもそもの利益の源泉であるユーザが離れてしまうので本末転倒ではないかと思う。

Weblocksの継続ベースの画面遷移

WeblocksCommon Lisp用のWebアプリケーションフレームワーク(WAF)。Common LispのWAFも色々出てきているみたいだけど、一番リッチに作り込まれているのはこのWeblocksだと思う。なにしろ1行のHTMLもJavascriptも書かずにWebアプリを作ることができるという触れ込みだ。一方でドキュメントが少なくかつ古いので分からないところはソースコードをあたるしかなかったりもする。インストールはquicklisp一発で済むので昔に比べればはるかに簡単になった。

;; インストール
(ql:quickload :weblocks)

;; スケルトン生成 (この場合 /home/coffeemug/projects/myapp というディレクトリができる)
(wop:make-app 'myapp "/home/coffeemug/projects/")

WeblocksはWebアプリをウィジェットの木として作るという考え方に基づいている。ウィジェットはCLOSオブジェクトで、最終的にHTML+Javascriptに展開されてブラウザに表示される。そのため、ウィジェットをどのように展開するかを記述するrender-widget-bodyというメソッドを持っている。ウィジェットは最初から色々そろっているが、もちろん自分で定義することもできる。

Weblocksは継続ベースの画面遷移ができるというところがミソらしい(参考 http://d.hatena.ne.jp/inuzini-jiro/20110310/1299735824)。普通のWAFではサーバサイドでセッションオブジェクトを保存し、ユーザはサーバとのやりとりの度にセッションIDを伝えて現在の状態を引き出さなければならない。一方で継続ベースの場合はセッションごとに継続という「それ以降の計算処理が保存された関数オブジェクト」を持っていて、同じユーザから再びリクエストがあったら前の継続の続きを再生する。プログラマとしてはセッションにまたがる変数をあたかも普通の局所変数のように扱えるので楽になる。Ajaxと継続を組み合わせることで、一部のウィジェットだけを置き換えたりもできる。

以下のコードはAjaxウィジェットの置き換えを行う。

(defun with-flow-test-page ()
  (let* ((comp-widget (make-instance 'composite))
	 (meta-comp-widget (make-instance 'composite :widgets (list comp-widget)))
	 (counter 0))
    (setf (composite-widgets comp-widget)
	  (list (make-widget (lambda () (with-html (:p (str (local-time:format-timestring nil (local-time:now))))
						   (:p "This is car of comp-widget"))))
		(make-widget
		 (lambda ()
		   (render-link
		    (lambda (&rest args)
		      (declare (ignore args))
		      ;; 第一引数はyieldの引数のウィジェットで置き換えられるウィジェット
		      (with-flow comp-widget
			(loop
			  (yield (make-widget
				  (lambda (cont) ; contが継続オブジェクト
				    (with-html (:p (str (local-time:format-timestring nil (local-time:now))))
					       (:p (str (format nil "with-flow loop 1st. counter=~A" counter)))
					       (render-link (lambda (&rest args)
							      (declare (ignore args))
							      (incf counter)
							      (answer cont)) ; with-flowにおける次の処理へ
							    "Goto 2nd"
							    :ajaxp t)))))
			  (yield (make-widget
				  (lambda (cont)
				    (with-html (:p (str (local-time:format-timestring nil (local-time:now))))
					       (:p (str (format nil "with-flow loop 2nd. counter=~A" counter)))
					       (render-link (lambda (&rest args)
							      (declare (ignore args))
							      (incf counter)
							      (answer cont))
							    "Goto 1st"
							    :ajaxp t))))))))
		    "replace comp-widget")))))
    (render-widget meta-comp-widget)))

(defun init-user-session (root)
  (setf (widget-children root)
	(list (make-widget
	       (lambda ()
		 (with-html(:p (str (local-time:format-timestring nil (local-time:now)))))))
	      #'with-flow-test-page)))

このWebアプリを実行してみるとこのような画面になる。

最初ウィジェットの構造はこうなっている。meta-comp-widgetやcomp-widgetウィジェットを格納するだけのcompositeウィジェット。"replace comp-widget"と表示されているリンクを押すと、with-flowマクロが呼び出されて、with-flowマクロの第一引数であるウィジェット、この場合comp-widgetが置き換えられる。

その結果がこの画面。

先ほどリンクを押したことでcomp-widgetがwith-flowマクロの中のyield以下のウィジェットに置き換わったのだ。新しいウィジェットにもリンクがあり、これを押すことでwith-flowマクロの中の2番目のyield以下のウィジェットにさらに置き換わる。

その時の画面がこれ。

二つのタイムスタンプが表示されているが、meta-comp-widgetに入っているタイムスタンプは最初から変わらない。一方、その下の次々に置き換わっていくウィジェットにより表示されるタイムスタンプは置き換えの度に更新されることが分かる。しかも、with-flowの本体部分ではloopを入れているのでリンクを押す度にページの一部分がトグルするようになっている。loopに限らず、任意のLispの制御構造を入れられるので、様々な条件に合わせてウィジェットを表示したりできる。
また、counterをページ遷移の度にインクリメントしているが、局所変数のように書いているにも関わらずページをまたいでも状態を保っていて、セッションオブジェクトみたいなものを明示的に用意する必要がない。これが継続ベースのWebアプリのメリットなのかな、と思う。他のWAF使ったことないけど・・・

lispbuilder-sdl-ttfで日本語を表示する

魔法言語リリカル☆LispみたいなものをCommon Lisp処理系の上に直接作れたらと思ったので、とりあえずlispbuilder-sdlで簡単なスクリプトエンジンを作ってみることにした。
と思ったら日本語テキストを表示するところでいきなりはまった。
当初はlispbuilder-sdl-ttfに付いてくるサンプルプログラムを少しいじって、次のようにしていたのだが、

(require :lispbuilder-sdl)
(require :lispbuilder-sdl-ttf)

(defparameter *ttf-font-takao*
  (make-instance 'sdl:ttf-font-definition
     :size 32
     :filename "/usr/share/fonts/truetype/takao-gothic/TakaoGothic.ttf")) ; ttfファイルの場所を指定する

(defun font-example ()
  (sdl:with-init ()
    (sdl:window 600 96 :title-caption "SDL-TTF Font Example" :icon-caption "SDL-TTF Font Example")
    (setf (sdl:frame-rate) 30)
    (sdl:fill-surface sdl:*white* :surface sdl:*default-display*)
    (unless (sdl:initialise-default-font *ttf-font-takao*)
      (error "FONT-EXAMPLE: Cannot initialize the default font."))
    (sdl:draw-string-solid-* "Text UTF8 - Solid 日本語テスト" 0 0
                             :color sdl:*black*)
    (sdl:draw-string-shaded-* "Text UTF8 - Shaded 日本語テスト" 0 32
                              sdl:*black*
                              sdl:*yellow*)
    (sdl:draw-string-blended-* "Text UTF8 - Blended 日本語テスト" 0 64
                               :color sdl:*black*)
    (sdl:update-display)
    (sdl:with-events ()
      (:quit-event () t)
      (:video-expose-event () (sdl:update-display))
      (:key-down-event ()
       (when (sdl:key-down-p :sdl-key-escape)
         (sdl:push-quit-event))))))

このままでfont-exampleを呼んでみると、日本語の部分が文字化けしてしまう。

lispbuilder-sdl-ttfのソースを読んでいくと、sdl-ttf-cffi::render-utf8-solidなどのUTF-8に対応した描画関数が定義されているにも関わらずsdl-ttf-cffi::render-text-solidなどのUTF-8非対応の関数しか呼ばれていないことが分かった。だから単純にこの関数を使っている部分を置き換えて再定義してやればいい。

(in-package #:lispbuilder-sdl)

(defmethod _render-string-solid_ ((string string) (font ttf-font) (color color) free cache)
  (let ((surf nil))
    (with-foreign-color-copy (col-struct color)
      (setf surf (make-instance 'surface
		    :fp (sdl-ttf-cffi::render-utf8-solid
			 (fp font)
			 string
			 (if (cffi:foreign-symbol-pointer "TTF_glue_RenderText_Solid")
			   col-struct
			   (+ (ash (b color) 16)
			      (ash (g color) 8)
			      (r color)))))))
    (when cache
      (setf (cached-surface font) surf))
    surf))

(defmethod _render-string-blended_ ((string string) (color color) (font ttf-font) free cache)
  (let ((surf nil))
    (with-foreign-color-copy (col-struct color)
      (setf surf (make-instance 'surface
		    :fp (sdl-ttf-cffi::render-utf8-blended
			 (fp font) string
			 (if (cffi:foreign-symbol-pointer "TTF_glue_RenderText_Blended")
			   col-struct
			   (+ (ash (b color) 16)
			      (ash (g color) 8)
			      (r color)))))))
    (when cache
      (setf (cached-surface font) surf))
    surf))

(defmethod _render-string-shaded_ ((string string) (fg-color color) (bg-color color) (font ttf-font) free cache)
  (let ((surf nil))
    (with-foreign-color-copy (fg-struct fg-color)
      (with-foreign-color-copy (bg-struct bg-color)
        (multiple-value-bind (fg bg)
            (if (cffi:foreign-symbol-pointer "TTF_glue_RenderText_Shaded")
              (values fg-struct bg-struct)
              (values (+ (ash (b fg-color) 16)
                         (ash (g fg-color) 8)
                         (r fg-color))
                      (+ (ash (b bg-color) 16)
                         (ash (g bg-color) 8)
                         (r bg-color))))
          (setf surf (make-instance 'surface
			:fp (sdl-ttf-cffi::render-utf8-shaded
			     (fp font) string fg bg))))))
    (when cache
      (setf (cached-surface font) surf))
    surf))

font-exampleの結果は次のような画面になってちゃんと表示される。

さらに、フォント定義クラスのインスタンスをwith-initマクロの中でinitialise-fontで初期化することによって、draw-string系の関数に色々なフォントを指定することができる。

(defparameter *ttf-font-definition-small*
  (make-instance 'sdl:ttf-font-definition
     :size 16
     :filename "/usr/share/fonts/truetype/takao-gothic/TakaoGothic.ttf"))

(defparameter *ttf-font-definition-normal*
  (make-instance 'sdl:ttf-font-definition
     :size 24
     :filename "/usr/share/fonts/truetype/takao-gothic/TakaoGothic.ttf"))

(defparameter *ttf-font-definition-big*
  (make-instance 'sdl:ttf-font-definition
     :size 32
     :filename "/usr/share/fonts/truetype/takao-gothic/TakaoGothic.ttf"))

(defvar *ttf-font-small*)
(defvar *ttf-font-normal*)
(defvar *ttf-font-big*)

(defun font-example ()
  (sdl:with-init ()
    (sdl:window 600 100 :title-caption "SDL-TTF Font Example" :icon-caption "SDL-TTF Font Example")
    (setf (sdl:frame-rate) 30)
    (sdl:fill-surface sdl:*white* :surface sdl:*default-display*)

    (setf *ttf-font-small* (sdl:initialise-font *ttf-font-definition-small*)
	  *ttf-font-normal* (sdl:initialise-font *ttf-font-definition-normal*)
	  *ttf-font-big* (sdl:initialise-font *ttf-font-definition-big*))
    
    (sdl:draw-string-solid-* "Text UTF8 - Solid 日本語テスト" 0 0
                             :color sdl:*black*
			     :font *ttf-font-small*)
    (sdl:draw-string-shaded-* "Text UTF8 - Shaded 日本語テスト" 0 32
                              sdl:*black*
                              sdl:*yellow*
			      :font *ttf-font-normal*)
    (sdl:draw-string-blended-* "Text UTF8 - Blended 日本語テスト" 0 64
                               :color sdl:*black*
			       :font *ttf-font-big*)
    (sdl:update-display)
    (sdl:with-events ()
      (:quit-event () t)
      (:video-expose-event () (sdl:update-display))
      (:key-down-event ()
       (when (sdl:key-down-p :sdl-key-escape)
         (sdl:push-quit-event))))))

このfont-exampleの結果はこう。

[LISP] メモ化

メモ化(memoization)は関数の引数と返値の対応をハッシュテーブルなどに保存しておくことにより、同じ引数で呼ばれた場合の再計算を防ぐプログラミング技法だ。ただし、メモ化する関数が内部状態を持っていて引数によらないで値が変わる場合、すなわち参照透明でない場合には使えない。
On Lispでは、クロージャの応用例として登場する。次の関数memoizeはハッシュテーブルを内部状態として持つクロージャを返す。

;; On Lispでのメモ化の実装
(defun memoize (fn)
  (let ((cache (make-hash-table :test #'equal)))
    #'(lambda (&rest args)
        (multiple-value-bind (val win) (gethash args cache)
          (if win
              val
              (setf (gethash args cache) 
                    (apply fn args)))))))

実際に使うときはどうなるだろうか。フィボナッチ数列の場合、素の実装だと時間がかかるが、

(defun fib (n)
  (cond ((= n 0) 1)
	((= n 1) 1)
	(t (+ (fib (1- n))
	      (fib (- n 2))))))


(time (fib 40))
; Evaluation took:
;   4.313 seconds of real time
;   4.459297 seconds of total run time (4.459297 user, 0.000000 system)
;   103.39% CPU
;   11,501,086,452 processor cycles
;   65,664 bytes consed
  
165580141

次のようにメモ化すると、

(defparameter memoized-fib (memoize #'fib))

(time (funcall memoized-fib 40))
; Evaluation took:
;  4.338 seconds of real time
;  4.347672 seconds of total run time (4.347672 user, 0.000000 system)
;  100.23% CPU
;  11,568,512,880 processor cycles
;  55,152 bytes consed

あれ?全く速くなってない。fibの定義中の再帰呼び出しはメモ化されていない元の関数を呼び出しているからだ。そのためfibを以下のように再定義する必要がある。

(defun fib (n)
  (cond ((= n 0) 1)
	((= n 1) 1)
	(t (+ (funcall memoized-fib (1- n))
	      (funcall memoized-fib (- n 2))))))

(defparameter memoized-fib (memoize #'fib))

(time (funcall memoized-fib 40))
; Evaluation took:
;  0.000 seconds of real time
;  0.000039 seconds of total run time (0.000039 user, 0.000000 system)
;  100.00% CPU
;  93,196 processor cycles
;  0 bytes consed
  
165580141

これで一応高速化できたわけだけど、関数定義の中でその時点ではまだ定義されていない変数を使うのは気持ち悪いし、マクロを使えばもっと自然に書けるはずだ。

実はCommon Lisp用のメモ化ライブラリはもうあるのでそれを使えばいいのだった。

(def-memoized-function fib (n)
  (cond ((= n 0) 1)
	((= n 1) 1)
	(t (+ (fib (- n 1))
	      (fib (- n 2))))))

(time (fib 40))
; Evaluation took:
;   0.000 seconds of real time
;   0.000024 seconds of total run time (0.000021 user, 0.000003 system)
;   100.00% CPU
;   57,104 processor cycles
;   0 bytes consed