PostScript で階乗のつづき。こんどは for 文で。

/func {1 exch -1 1 {mul} for} def

ようするに、自分がしたい操作に必要な変数が、適切な数だけ適切な順番でスタックに積まれているようにすればいいらしい。そしてスタックというやつからは、直前に積んだものだけを取り出すことができる。

たとえば上記で定義した階乗のオペランド func を以下のように呼び出すと、

GS> 5 func

まず 5 がスタックに積まれる。この 5 は「funcへの引数」のつもりなんだけど、スタックから見るとそんなつもりはなくて、ただ値が積まれただけ。次は func を積むんだけど、func は上記のように定義されているので、その定義の一番最初にある 1 がスタックに積まれる。この時点のスタックの状態はこんな感じ。

 1 
---
 5 

func の定義によれば、次は exch だ。これは、それまでスタックの1番上にあった要素とその下の要素を入れ替える。つまり、スタックの状態はこうなる。

 5
---
 1

さらに -1 と 1 を順番に積んで、スタックの状態はこうなる。

 1 
---
-1
---
 5
---
 1

ここで、本文が mul だけの for が登場する。for というオペレータは、スタックの値を 3つ消費し、それぞれの値を深いほうから順番に「繰り返しの最初」「繰り返しの更新」「繰り返しの終わり」として本文を繰り返す。ただし毎回の繰り返しでは、スタックの先頭に、そのターンにおける変数のようなものが積まれる。こう書くと複雑だけど、ようは最初に本文を実行するときには「5」が、2回目は「4」が、...、5回目は「1」がスタックの先頭に積まれるということ。つまり1回目の繰り返しのとき、スタックの状態はこう。

 5
---
 1

本文の mul は、このスタックから値を 2つ取り出して、それらの積をあらためてスタックに積む。したがってスタックの状態は、

5

2回目の繰り返しに際してスタックの先頭に「4」が積まれる。

 4 
---
 5

このスタックで mul を適用すると、

 20

3回目の繰り返しに際してスタックの先頭に「3」が積まれる。

 3 
---
 20

mul を適用して

 60

4回目の繰り返しに際してスタックの先頭に「2」が積まれる。

 2 
---
 60

mul を適用して

120

5回目の繰り返しに際してスタックの先頭に「1」が積まれる。

 1 
---
120

mul を適用して

120

おしまい。こうして最後のスタックの値を取り出せば（そのためには == を使う）、5の階乗の値が得られる。

たぶん用語の使い方はいいかげん。はやく教科書こないかな。

PostScript が意外におもしろいので真剣に勉強してみようと思う。教科書は、Web で PDF が全部公開されている "Thinking in PostScript" に決めた。書籍はもうとっくに絶版らしい。でも物理的な本が手もとにないとつらいんだよなあ。Amazon マーケットプレイスにも出品されているけどバカみたいに高額なので（6000円以上）、US の同様のサービスに注文した（600円くらい）。まだ届かない。出荷された気配もない。もう待ちきれないよう。

というわけで、試行錯誤しながら階乗を考えてみた。

 /func {dup 1 eq {1 mul} {dup 1 sub func mul} ifelse} def

実行結果。

GS> 10 func ==
3628800
GS> 20 func ==
2.43290202e+18
GS> 100 func ==
inf.0

どうやら再帰的なオペレータの定義ができるらしい。はじめは、ふつうに for を使って解こうとしたんだけど、わかりませんでした。

ところで Emacs の ps-mode は GS のビューワーと連動して出力結果がリアルタイムで見られてすごい。便利すぎ。ただしお絵描きを始めると日付が変わるようだ。

Schemeの多値の正体は継続

SICPでは「多値」を表立って使うことはない。ただ、5.2.2で2種類のリストをやりとりするときに2変数のプロシージャを使った一見するとトリッキーな処理が登場して、これが実は多値なんだよという種明かしを脚注4でやっている。さらに、そのトリッキーな2変数プロシージャのことを継続（continuation）と呼ぶと説明している。

多値も継続だったのか。

噛みしめるために小さな例を考えてみた。つぎのプロシージャ one は、プロシージャ sincos が返す 2 値を受け取り、その 2 乗和を返す。sincos は引数の角度に対する sin の値と cos の値を返すので、プロシージャ one は引数にどんな数値を指定しても実数の 1 を返す。

(define (one rad)
  (receive (sin cos)
      (sincos rad)
    (+ (* sin sin) (* cos cos))))

(define (sincos rad)
  (values
    (sin rad) (cos rad)))

このプロシージャ one は、values や receive という組み込みの多値のしくみを使わなくても、つぎのように継続を表すプロシージャ cont を使って多値を模倣できる。

(define (one rad)
  (sincos
    rad
    (lambda (sine cosine)
      (+ (* sine sine) (* cosine cosine)))))

(define (sincos rad cont)
  (cont (sin rad) (cos rad)))

いちおう実行結果。

gosh>(one 123456)
1.0
gosh>(one -9876)
1.0

まとめ

計算の一部または全部をどうにかしたい場合があって（よその関数に渡したいとか、ちょっと保留しておきたいとか）、そのときの定石は「プロシージャでくるんでしまえ」。で、そういうプロシージャのことを「継続」（continuation）と呼ぶ。

ついやってしまった。

Functional Programming IAT
関数型指数（潜在的な関数型プログラミングの嗜好度）をはかる IAT
http://dame.dyndns.org/misc/fpiat/


「あなたの関数型指数は 0.62331761674765 です。正が関数型、負が手続き型です。」

でも、設問では"Lisp"（Schemeではない）が関数型言語とされているんだけど、それはどうなの？

練習問題を放置したままだったSICPの第5章をぽちぽち再開。こうやって再読してみると、すっかりどんな話だったか忘れてる。やっぱり手を動かさないで本を読んでいるだけじゃなんにも身につかない。編集という、まさに読んでいるだけの職業に自分が従事している現実を呪うのはこういう瞬間だ。ただの逆ギレだけど。

というわけで第5章の練習問題に着手しはじめた。ところがすぐに困っちゃったのは、この章の内容がGauche（などのSchemeインタプリタ）で式を実行すれば確かめられる話じゃないこと。とくに5.2節でレジスタマシンのシミュレータをSchemeで作るまでは、紙と鉛筆でデータの流れを図示したりしながら、脳内レジスタマシンを妄想して読み進めるしかない。「レジスタマシンの動作を手でシミュレートしろ」といった問題を考えるのは楽しいんだけど、どうにも「わかった気になっているだけかも」という懸念がぬぐえないのが気持ち悪い。どうでもいいけど、専門書や専門雑誌の編集者を楽しく長く続けていくのに求められる最強のスキルは、「わかった気になったところで留まっていられる」ことだとおもう。前々から気がついてはいたけれど、最近になってひどく実感するようになった。こういう感情をわざわざ書きとめているということは、そういうことだ。ここまでどうでもいい話。

この気持ち悪さはレジスタマシンがあれば解決する。かといって5.2節でシミュレータを作るまで待ってられないし（経験上、1問でも練習問題をぬかすと最後まで練習問題に手をつけずに読了する。帰納法で証明できたらかっこいいかもね）、そもそもSchemeでシミュレートするっていうのも気持ちが悪い。最初にこの章を読んだときは「これは教科書として画期的なアイデアだ」と思ったけど、実際はめんどくささのランクをひとつ繰り上げているだけなような気もする。

アセンブリというわけにもいかないので、Cで書いてみることにした。たとえばフィボナッチ数列の第n項を求めるレジスタマシンのコントローラ（原書512ページのFigure5.12）。

/* Implementation of a recursive fibonachi machine in C.
   (Figure 5.12 of "SICP")
   2007/6/17
   k16.shikano@gmail.com
*/ 

#include <stdio.h>
#include <stdlib.h>
#define STACKSIZE 100

void fibloop();
void afterfib1();
void afterfib2();
void fibdone();
void immediate();
void rtc(int);

void initstack();
void save(int);
int restore();

int cont = 0;
int val;
int n;

main(int argc, char *argv[])
{ 
  initstack();
  n = atol(argv[1]);

  fibloop();
}

void fibloop()
{
  while(n >= 2)
    {
      save(cont);
      cont = 1;
      save(n);
      n = n - 1;
    }
  immediate();
}  

void afterfib1()
{
  n = restore();
  cont = restore();
  n = n - 2;
  save(cont);
  cont = 2;
  save(val);
  fibloop();
}

void afterfib2()
{
  n = val;
  val = restore();
  cont = restore();
  val = val + n;
  rtc(cont);
}

void immediate()
{
  val = n;
  rtc(cont);
}

void fibdone()
{
  printf("answer = %d\n", val);
  exit(1);
}


/* return to continue */
void rtc(int c)
{
  switch(c)
    {
    case 0: fibdone();
    case 1: afterfib1();
    case 2: afterfib2();
    }
}


/* naive stack implementation */
int stack[STACKSIZE];
int *pstack;
int *pinit;

void initstack()
{
  pstack=stack;
  pinit=pstack;
}

void save(int val)
{
  if (pstack > pinit+STACKSIZE){
    perror("Reached Stack End");
    exit(1);
  }

  *pstack=val;
  ++pstack;
}

int restore()
{
  if (pstack == pinit){
    perror("Reached Stack Head");
    exit(1);
  }

  --pstack;
  return *pstack;
}

スタックの機能をでっちあげて、Figure5.12にあるSchemeっぽい式をもじどおりCに置き換えただけ。コンパイルして実行すると（想定内のセグメンテーション違反はおこすけど）あっさりうごく。

k16@debian:~/play $ ./fib 24
answer = 46368
k16@debian:~/play $ ./fib 25
セグメンテーション違反です

これは、Cでフィボナッチを書きました、という話ではなく、これまでSchemeというレイヤでプログラミングしているときに再帰関数だと思っていたコレが、

(define (fib n)
        (if (< n 2)
            n
            (+ (fib (- n 1)) (fib (- n 2)))))

その下のレイヤでは上記のCのコードのようなレジスタへの代入とスタックへの出し入れだけの形（現代のコンピュータがかろうじて完璧に扱える形）に解くほぐせて、しかも動く、という話なんだよね。プログラミング言語っていうのは、もしかして、ここで手動で試してみたコードからコードへの変換みたいな処理を自動的に行うしくみのことなのか？

なんだかこの本を読みはじめたときのようなわくわく感が。

地球の裏側までトンネルを掘ってボールを落としたらどうなるかという話題になった。空気がなくて、他の天体の重力の影響を無視できて、トンネルが地球の重心を通る直線で、トンネルの壁が重力によって押しつぶされなくて、なんかほかにもいろいろ条件を満たすなら、ボールは反対側の地表付近まで届く。トンネルの途中でぴたっと止まっちゃうことはない。力学は昔も今もさっぱり自信がないんだけど、その理由を文章で説明するとしたらこんな感じになると思う。

ボールはトンネルの真ん中まで落ちるあいだ、つねに一定の加速度で移動する。
つまり、どんどん速度が増える。
トンネルの真ん中付近を突っ切るときが最速で、そこから先は正反対の向きの加速度で移動する。
つまり、だんだんゆっくりになる。
そのうち前半の行程で得たエネルギーを使い果たし、反対側の地表付近で一瞬静止して、今度はもときた方向へ落ちていく。
以下繰り返し。

で、こういう問題を考えるときは「地球の中心に全質量が集中している」と見たてることになっているわけだけど、その理由を説明するのがむずい。この場合の「見たて」は、たとえば数学で「0.99999… = 1」とか規定するのと違って、そう考えると議論に都合がいいからという性質だけのものじゃなく、もっと本質的な話だったはず（もちろん、どんな理学的な説明だって「そのほうが都合がいいから」って言い方はできるんだろうけど……）。で、昼休みにWikipediaを見てみたら、あっさり証明がのっていた。（読んではいない）

Shell theorem
http://en.wikipedia.org/wiki/Newton%27s_sphere_theorem

もしボールがトンネルを移動している最中に球に地球が真っ二つに割れたら？という話も出たけど、それまでにボールが得ている運動エネルギーと変化した周囲の重力から得るエネルギーとが均衡するように動くとしか……（実際には地球を真っ二つに割ることになった外因からのエネルギーがいちばん大きく影響するんじゃない？）

パズル「グリッド色分け問題」少し改良版

「組合せ最適化」をぱらぱらめくったけど安直な方法が見つけられなかったので、オクトーバーフェストに行ってビールをのみながらほげほげ考えていたら、行ごとに組み合わせを求めつつ枝刈りして、それを枝刈りしながら列に集めれば、ずいぶんメモリを省略できるはずだと思いついた。実際これはうまくいって、4x4程度なら瞬時に計算できる。

たとえば10番目に得られた結果。10番目であることに特に意味はない。

(use srfi-1)
(use util.stream)

(define (line-colorings width colors pred)
  (cond ((= 1 width)
         (apply stream (zip (iota colors colors -1))))
        ((= 0 colors)
         stream-null)
        (else
         (let R ((top colors))
           (if (= 0 top)
               stream-null
               (stream-append
                (stream-filter
                 pred
                 (stream-map (cut cons top <>)
                             (line-colorings (- width 1) colors pred)))
                (R (- top 1))))))))

;; (stream of lists) -> (stream of lists)
(define (grid-colorings hight rows patterns pred)
  (cond ((= 1 hight)
         patterns)
        ((stream-null? patterns)
         stream-null)
        (else
         (let R ((top (stream-car patterns))
                 (rest (stream-cdr patterns)))
           (stream-append
            (stream-filter
             pred
             (stream-map (cut append top <>)
                         (grid-colorings (- hight 1) rows patterns pred)))
            (if (stream-null? rest)
                stream-null
                (R (stream-car rest) (stream-cdr rest))))))))

(define (tiles lines rows colors)
  (stream-filter 
   (cut egalite? <> (quotient (* lines rows) colors) colors)
   (grid-colorings lines rows 
     (line-colorings rows colors 
       (cut stripe? <>))
     (cut staggered? <> rows))))


;;;; predicates
; Doesn't the list contain adjacent cells with same color?
(define (stripe? ls)
  (cond ((null? ls)
         #t)
        ((null? (cdr ls))
         #t)
        (else
         (let ((v (car ls))
               (w (cadr ls)))
           (and (not (= v w))
                (stripe? (cdr ls)))))))

; Doesn't the list contain vertically adjucent cells with same color?
(define (staggered? ls rows)
  (let R ((rows (transpose ls rows)))
    (if (null? rows)
        #t
        (and (stripe? (car rows))
             (R (cdr rows))))))

; Does each color appear at least n times?
(define (egalite? ls n c)
  (let R ((c c) (ls ls))
    (cond ((= c 0) #t)
          ((< (length ls) n) #f)
          (else
           (receive (the-colors rest)
               (partition (cut = c <>) ls)
             (and (>= (length the-colors) n)
                  (R (- c 1) rest)))))))



;;;; some list utils
(define (group ls n)
  (receive (front end)
      (split-at ls n)
    (if (null? end)
        (list ls)
        (cons front (group end n)))))
(define (transpose ls rows)
  (apply zip (group ls rows)))

パズル「グリッド色分け問題」をSchemeで解く

自宅のトイレにはディック・ブルーナのポスターがもう何年も張ってある。全体がグリッドに仕切られていて、そのひとつひとつに彼の代表作から抜き出した絵が並べられてるんだけど、そのうちの1枚に描かれているテーブルクロスの柄が気になってしょうがない。



どうしてこのテーブルクロスは、きちんと格子が塗り分けられていないんだろう。左下で青いマスが横に並んじゃっているのがどうにも気持ち悪い。行列の成分でいうと33と34の2つ。もしスプーンがおかれてなかったら境界が識別できないじゃないか。4x4のグリッドを3色で塗り分けるパターンなんていくらもあるだろうに。

というわけでパターンを求めてみる。

戦略は、まず塗り分けのパターンをすべて求めて（つまり隣同士が同じ色に塗られるパターンを含む）、そのうちで3色をちゃんと使ってうまく塗り分けられているものを取り出す。

「3色をちゃんと使ってうまく塗り分けられている」はどう評価しよう？　
とりあえず、どの色も少なくとも5回（16÷3）は使われていて、隣同士が違う色になっていればよしとしよう。（デザイン上のよしあしを評価するとしたら何を考えたらいい？）

4x4のグリッドを塗り分けるパターンは、長さ16のリストであらわすことにする。使う色は1,2,3という数値で表す。つまり、リストの各要素には、各マスの色を意味する1,2,3のいずれかの数値がはいる。これをグリッドの左上→右下という順番で並べる。たとえば以下のような塗り分けは、(1 3 2 3 3 2 1 2 1 3 2 1 3 2 1 3) というリストであらわすことにする。（ 1：青、2：オレンジ、3：緑）



隣同士が別の色で塗り分けられているかどうかは、ベタに縦横の関係を調べる patch? というプロシージャを定義して、それで済ませることにする。

(define (stripe? ls)
  (cond ((null? ls)
         #t)
        ((null? (cdr ls))
         #t)
        (else
         (let ((v (car ls))
               (w (cadr ls)))
           (and (not (= v w))
                (stripe? (cdr ls)))))))
(define (patch? ls n m)
  (and (let L ((lines (group ls n)))
         (if (null? lines)
             #t
             (and (stripe? (car lines))
                  (L (cdr lines)))))
       (let R ((rows (transpose ls n)))
         (if (null? rows)
             #t
             (and (stripe? (car rows))
                  (R (cdr rows)))))))

ところでgroupとtransposeは、いつも使いたいときに一瞬探すんだけど見つからなくて、そのたびに下手な実装をしてる気がする。今回はこんなんで。

(define (group ls n)
  (receive (front end)
      (split-at ls n)
    (if (null? end)
        (list ls)
        (cons front (group end n)))))
(define (transpose ls rows)
  (apply zip (group ls rows)))

塗り分けパターンをすべて求めるにはどうしたらいいか。

たとえば、3つのマスを3色で塗り分けるやり方をすべて求めることを考えてみよう。以下のようなマスA,B,Cを緑黒赤の3色で塗り分けるパターンをすべて求めたい。

A

B

C

いま、都合よく R という関数があって、これを使うと2マスを3色で塗り分けパターンが全部求められるとしよう。R を使えば、以下の 3つの結果をよせ集めることで、3マスの塗り分けパターンを求めることができる。

1. Aを緑に塗って、BとCは R に従って塗り分ける全パターン
2. Aを黒に塗って、BとCは R に従って塗り分ける全パターン
3. Aを赤に塗って、BとCは R に従って塗り分ける全パターン

ようするに、うしろの塗り分け方さえ全部求まってれば、先頭の色だけとっかえひっかえした結果をよせ集めることで、全体の塗り分けがすべて得られる。



このアイデアをストリームを使ってダイレクトにコードにするとこんな感じ。Scheme だと簡単すぎ。

(use srfi-1)
(use util.stream)

(define (gen-colorings width colors)
  (cond ((= 1 width)
         (apply stream (zip (iota colors colors -1))))
        ((= 0 colors)
         stream-null)
        (else
         (let R ((top colors))
           (if (= 0 top)
               stream-null
               (stream-append
                 (stream-map (cut cons top <>)
                             (gen-colorings (- width 1) colors))
                 (R (- top 1))))))))

あとは、先に定義した patch? を使ってストリームをフィルタリングすればいい。どの色もだいたい平等に塗られているかどうかを調べるプロシージャ egalite? も定義しておいて、ここであわせてフィルタリングする。

(define (tiles n m c)
  (stream-filter 
   (lambda (tone)
     (and 
      (egalite? tone n c) 
      (patch? tone n m))
   (gen-colorings (* n m) c)))

(define (egalite? ls n c)
  (let R ((c c) (ls ls))
    (cond ((= c 0) #t)
          ((< (length ls) n) #f)
          (else
           (receive (the-colors rest)
               (partition (cut = c <>) ls)
             (and (>= (length the-colors) n)
                  (R (- c 1) rest)))))))

これで (tiles 4 4 3) とかって実行すれば、塗り分けパターンを順次計算してくれるストリームが帰ってくる。はずなんだけど、実際には組み合わせが爆発しちゃう。16マスを3色に塗り分けようと思ったら 3¹⁶ = 43,046,721 のパターンがありうるわけで、すべての塗り分けパターンからなるリストを作ったりすると巨大なリストになって身動きが取れなくなると思ってストリームを使ってみたんだけど、どのみち4x4=16マスの3色塗り分けを全部求めるのは無理だったもよう。
しかたがないので、問題を1行小さくして 3x4 の横長のテーブルクロスの3色塗り分けを求めてお茶を濁すことにした。

gosh> (define s (tiles 4 3 3))
s
gosh> (stream->ref s 1)
(3 2 1 3 2 1 3 2 1 2 1 3)
gosh> (stream-ref s 2)
(3 2 1 3 2 1 2 1 3 2 1 3)
gosh> (stream-ref s 3)
(3 2 1 2 1 3 2 1 3 2 1 3)
gosh> 

最初に得られる結果を先の色定義（ 1：青、2：オレンジ、3：緑）で塗り分けると、こうなる。



ついでに、このHTMLテーブルを描くのにでっちあげた補助関数。

(define (tile->html tile rownum)
  (define (num->color n)
    (cond
     ((= 1 n) "blue")
     ((= 2 n) "orange")
     ((= 3 n) "green")
     (else    "black")
     ))
  (define (line->str line)
    (string-append 
     "<tr>\n  "
     (apply string-append 
       (map (lambda (cell)
              (string-append "<td style=\"background-color:" 
            (num->color cell) 
       "\"><div style=\"width:1em\">&nbsp;</div></td>"))
                               line))
     "\n</tr>\n"))
  (define (lines->str lines)
    (string-append "<table>\n" 
                   (apply string-append (map (cut line->str <>) lines))
                   "</table>\n"))
  (lines->str (group tile rownum)))

しかし、tilesの引数は順番を逆にするべきだったな。行と列がいれかわってて紛らわしいことこのうえない。

XMLっぽい構造をパースする

指定した範囲の内側でだけ、テキストのパターン置換をしたい。つまり、こういうことがしたい。

gosh> str
"<title>
  <en>Introduction</en>
  <ja>は じ め に</ja>
</title>
<p>
  <en>
    Here we'll discuss about english
      <footnote>
        <p class="footnote">
          Or, any language you speak as a native tongue.
        </p>
      </footnote>
    .
  </en>
  <ja>
    ここでは日本語
      <footnote>
        <p class="footnote">
          で な く て も、母 国 語 な ら な ん で も い い。
        </p>
      </footnote>
    について説明しよう。
  </ja>
</p>"

gosh> (regexp-replace-all-among-all 'ja #/\b\s\b/ str "")
"<title>
  <en>Introduction</en>
  <ja>はじめに</ja>
</title>
<p>
  <en>
    Here we'll discuss about english
      <footnote>
        <p class="footnote">
          Or, any language you speak as a native tongue.
        </p>
      </footnote>
    .
  </en>
  <ja>
    ここでは日本語
      <footnote>
        <p class="footnote">
          でなくても、母国語ならなんでもいい。
        </p>
      </footnote>
    について説明しよう。
  </ja>
</p>"

先日のような邪道な試行錯誤をしたり、再帰下降パーザについて少し勉強したりした結果、地道にパーズするのがいちばんだということがよく分かった。PerlやJaveなら優れたXML処理のライブラリを使うべきなのかもしれないね。

置換をほどこしたい領域（上の例では<ja>...</ja>の部分）を取り出すことから考えよう。その前に、XMLっぽいテキストを構成するパーツを先頭から順番に取り出してくれるプロシージャ read-xml があると仮定する。read-xml を一回呼ぶと、「<title>」や「<p class="footnote">」のようなタグ、もしくは、タグの前後の本文を、テキストの先頭から順番にゲットできる。こんな感じ。

(with-input-from-string "aaa<p>bbb</p>ccc"
  (lambda ()
    (read-xml) ; ⇒ aaa
    (read-xml) ; ⇒ <p>
    (read-xml) ; ⇒ bbb
    (read-xml) ; ⇒ </p>
    (read-xml) ; ⇒ ccc
  ))

この read-xml でひとつずつパーツを取り出してチェックしていく。探している領域を開始するタグ（いまの例では<ja>）が取り出せたら、終了を表すタグ（いまの例では</ja>）が現れるまで次々にパーツをつないでいくことで、ほしい領域が取り出せる。領域がネストしている可能性もあるので、開始タグの数もチェックしておくようにする。ざっくり書くとこんな感じ。利便性を考えて、領域の前後の文字列も返すようにした。

(define (xml-maximal-region tagname)
  (define (xmltag? e)
    (and (> (string-length e) 1)
         (char=? #\< (string-ref e 0))))
  (define (tag->name e)
      (string-trim-right
       (x->string (string-drop e 1))
       #\>))
  (define (start-tag? e)
    (and (xmltag? e)
         (equal? (x->string tagname)
                 (tag->name e))))
  (define (end-tag? e)
    (and (xmltag? e)
         (equal? (x->string tagname)
                 (string-drop (tag->name e) 1))))
  (define (rest-xml)
    (let R ((next (read-xml)))
      (if (string-null? next)
          ""
          (string-append next (R (read-xml))))))
  (define (in-region e body c before)
    (cond ((string-null? e)
           (error "Premature end of input -- GET-XMLTAGGED-MAXIMAL-REGION"))
          ((end-tag? e)
           (if (= 0 c)
               (values before (string-append body e) (rest-xml))
               (in-region (read-xml) (string-append body e) (- c 1) before)))
          ((start-tag? e)
           (in-region (read-xml) (string-append body e) (+ c 1) before))
          (else
           (in-region (read-xml) (string-append body e) c before))))
  (define (out-region e body before)
    (cond ((string-null? e)
           (values before "" ""))
          ((start-tag? e)
           (in-region (read-xml) e 0 before))
          (else
           (out-region (read-xml) body (string-append before e)))))
  (out-region (read-xml) "" ""))

この xml-maximal-region を使えば、求めるプロシージャ regexp-replace-all-among-all が簡単に定義できる。

(define (regexp-replace-all-among-all region-declaration rx str sub)
  (with-input-from-string str
    (lambda ()
      (receive (before region after)
           (xml-maximal-region region-declaration)
        (string-append before
                       (regexp-replace-all rx region sub)
                       (if (string-null? after)
                           after
                           (regexp-replace-all-among-all region-declaration rx after sub)))))))

あとは read-xml を書けばいい。むずかしいところはないけど面倒。長いので、全体とあわせて下記を参照。

replace-among.scm


References

---

「なんでも再帰」Shiro Kawai（2003/1）
http://www.shiro.dreamhost.com/scheme/docs/tailcall-j.html

『Perl & XML』：Erik T. Ray,Jason McIntosh（2002/11）
http://www.amazon.co.jp/dp/4873111064

二分木が描きたい。

Scheme を使っていると木を使うことが多い（Scheme に限らないけど）。教科書なんかには整形された木の絵がよく出てくるけど。あれはみんなどうやって描いているんだろう。きっと PostScript のコマンドを生成したりして描いているに違いない。そこで、再帰下降パーザの例としてありがちな四則演算を表す木を描くのに挑戦してみた。

arithmetic-culc-tree.scm

$ gosh arithmetic-culc-tree -tree ps
1*2+3*((4+5)-7)/(8+9)
%!
<< /PageSize [460.0 350.0] >> setpagedevice
newpath
175.0 297.0 moveto
85.0 270.0 lineto
175.0 297.0 moveto
265.0 270.0 lineto
...(以下略)

convert で png に変換した結果。

もうちょっと見ための改善の余地がありそうだけどもうつかれた。

Gaucheの単体テストで、副作用により標準出力に書き出す処理（displayとか）の動作をテストしたい。つまり、こんな単体テストをしたい。

(test* "display test"
       "foobar string"
       (display "foobar string"))

もちろんこれは失敗する。関数 test は equal? で第2引数と第3引数を比較するだけだから。オプション引数を与えて比較に使うプロシージャを変更することもできるけど、そもそも上記のような display のテストでは第3引数を評価した値が # でしかないので、テストの意味をなさない。

display の動作を脳内シミュレートすると、こんなふうに出力ポートを曲げればうまくいきそう。

(test* "display test"
       "foobar string"
       (with-output-to-string (lambda () (display "foobar string"))))

どうやらうまくいく。あとはこんなマクロをでっちあげておけばうれしい。

(define-syntax test-with-output*
  (syntax-rules ()
    ((_ e1 e2 e3)
     (test* e1 e2 (with-output-to-string (lambda () e3))))
    ((_ e1 e2 e3 e4)
     (test* e1 e2 (with-output-to-string (lambda () e3)) e4))))

結果。

gosh >(test-with-output* "display test"
                   "foobar string"
                   (display "foobar string"))
test global conversion 2, expects "foobar string" ==> ok
#<undef>

文字列を螺旋にそって描く。これに似ているけど、もっと単純に、ASCIIのみからなる文字列を同心円状の渦巻に沿って出力する。交差はさせない。(できない)

howm wiki - spiral.el
http://howm.sourceforge.jp/cgi-bin/hiki/hiki.cgi?SpiralDotEl

昨日定義した関数たちを改良して、

• 螺旋のパラメータを指定できるようにする
• state の列に真偽値ではなく各文字を対応させる（同じ座標の state を飛ばす処理も必要）

ようにする。

;; num -> direction -> type -> [state]
(define (make-spiral-states length start-x start-y start-direction l-or-r)
  (define (make-spiral-series total)
    (let* ((most (floor (/ (- (sqrt (+ 1 (* 8 (- total 1)))) 1) 2)))
           (lmost (iota (- most 1) 2 1))
           (rest (- total (fold + 1 lmost))))
      (append (list 2) lmost (if (zero? rest) '() (list rest)))))
  (let ((series (make-spiral-series length))
        (init-state (make-state start-x start-y start-direction))
        (turn (if (equal? l-or-r 'left) turn-left turn-right)))
    (scanf init-state (concatenate (map (lambda (n) (append (keep-moving n) (list turn))) series)))))

;; [state] -> [codes]
(define (normalize states)
  (let R ((ps '()) (codes (map car states)))
    (cond ((null? codes)
           ps)
          ((member (car codes) ps)
           (R ps (cdr codes)))
          (else
           (R (cons (car codes) ps) (cdr codes))))))

;; [codes] -> [state]
(define (stick-char codes chars)
  (map (cut list <> <>) codes chars))

;; [state] -> [[char]]
(define (bitmap ps)
  (define (range xs)
    (list-ec (: i (apply min xs) (+ (apply max xs) 1)) i))
  (define (corresponding-char code ps)
    (cond ((null? ps) " ")
          ((equal? code (caar ps)) (cadar ps))
          (else (corresponding-char code (cdr ps)))))
  (let ((codes (map car ps)))
    (list-ec (: x (range (map car codes)))
             (list-ec (: y (range (map cadr codes)))
                      (corresponding-char (list x y) ps)))))

;; [[char]] -> string
(define (picture bitmap)
  (string-join 
   (map (lambda (line) (string-join (map x->string line) "" 'strict-infix)) 
        bitmap)
   "\n" 'strict-infix))


(define (display-spiral string)
  (let ((length (string-length string)))
    (display 
     (picture
      (bitmap
       (stick-char
        (normalize (make-spiral-states length 0 0 2 'left))
        (string->list (string-join (string-split string #[\s]) "+" 'strict-infix))))))
    (newline)
    (values)))

実行例（サンプルの文字列は Gauche のトップページから引用）

gosh> (display-spiral "Gauche is an R5RS Scheme implementation developed to be a handy script interpreter,
which allows programmers and system administrators to write small to large scripts for their daily chores.
Quick startup, built-in system interface, native multilingual support are some of my goals.")

                Gauche+
                      i
nterpreter,+which+all s
i                   o +
+ all+to+large+scri w a
t m               p s n
p s ,+built-in+sy t + +
i + p           s s p R
r e u ingual+su t + r 5
c t t l       p e f o R
s i r i +my+g p m o g S
+ r a t f   o o + r r +
y w t l o   a r i + a S
d + s u + .sl t n t m c
n o + m e     + t h m h
a t k + mos+era e e e e
h + c e         r i r m
+ s i vitan+,ecaf r s e
a r u             + + +
+ o Q+.serohc+yliad a i
e t                 n m
b artsinimda+metsys+d p
+                     l
ot+depoleved+noitatneme

スクリプトの全体→ spiral-string.scm

R.バード『関数プログラミング』の亀の子図形問題、Scheme版

『関数プログラミング』（R. バード,P.ワドラー著/武市 正人訳）に亀の子図形の例題がある。その一筆書きバージョンを Gauche で書くとこんな感じ。

;; state -> state
(define (move state)
  (match state
    (`((,x ,y) 0) (make-state (- x 1) y 0))    ;; N
    (`((,x ,y) 1) (make-state x (- y 1) 1))    ;; W
    (`((,x ,y) 2) (make-state (+ x 1) y 2))    ;; S
    (`((,x ,y) 3) (make-state x (+ y 1) 3))    ;; E
    ))

;; state -> state
(define (turn-left state)
  (let-state state
      (x y d)
    (make-state x y (remainder (+ d 1) 4))))

ただし、

(define (make-state x y d)
  (list (list x y) d))

(define-syntax let-state
  (syntax-rules ()
    ((_ e1 (e2 e3 e4) e5 ...)
     (let ((e2 (caar e1))
           (e3 (cadar e1))
           (e4 (cadr e1)))
       e5 ...))))

とする。

この move と turn-left（および同様に定義した turn-right）を使って「鉛筆の軌跡」をつくり、それを適当な大きさのビットマップに対応させれば、結果として絵が描ける。そのためのプロシージャは、たとえば以下のように定義すればいい。

;; [state] -> [[boole]]
(define (bitmap-by-truth-value ps)
  (define (range xs)
    (list-ec (: i (apply min xs) (+ (apply max xs) 1)) i))
  (define (orlist ls)
    (cond ((null? ls) #f)
          ((car ls) #t)
          (else
           (orlist (cdr ls)))))
  (define (in? x xs)
    (orlist (map (cut equal? <> x) xs)))
  (let ((codes (map car ps)))
    (list-ec (: x (range (map car codes)))
             (list-ec (: y (range (map cadr codes)))
                      (in? (list x y) codes)))))

;; [[boole]] -> string
(define (picture-with-numbermark bitmap)
  (string-join
   (map (lambda (y)
          (string-join (map (lambda (x) (if x "#" " ")) y) "" 'strict-infix))
        bitmap)
   "\n" 'strict-infix))

（ちなみにコード中にコメントで示している型は厳密なものではなく、コードを書くときの便宜的なものです。）

教科書には正方形を描く例がある。でもそれは面白くない。簡単な応用として螺旋模様を描いてみよう。

(define (make-simple-spiral-states length)
  (define (make-spiral-series total)
    (let* ((most (floor (/ (- (sqrt (+ 1 (* 8 (- total 1)))) 1) 2)))
           (lmost (iota (- most 1) 2 1))
           (rest (- total (fold + 1 lmost))))
      (append (list 2) lmost (if (zero? rest) '() (list rest)))))
  (let ((series (make-spiral-series length))
        (init-state (make-state 0 0 0)))
    (scanf init-state (concatenate (map (lambda (n) (append (keep-moving n) (list turn-left))) series)))))

keep-moving と scanf は以下のような関数。

;; num -> (state -> [state])
(define (keep-moving n)
  (list-tabulate n (lambda (i) move)))

;; (alpha -> beta) -> gamma -> [alpha -> beta]
(define (scanf init procs)
  (if (null? procs)
      '()
      (let ((value ((car procs) init)))
        (cons value
              (scanf value (cdr procs))))))

実行するとこんな感じ。

gosh> (display (picture-with-numbermark (bitmap-by-truth-value (make-simple-spiral-states 55))))
###########
          #
  ####### #
  #     # #
  # ### # #
  # # # # #
  # #   # #
  # ##### #
  #       #
  ##########<undef>

（srfi-1 と srfi-42 と util.match が必要）

数学的帰納法は超限帰納法により証明します。超限帰納法は整列集合の性質から導かれます。たしかに大学の集合論の授業でこれを最初に知ったときはびっくりした。

うすうす感じてたんだけど、どうやら僕の生き方は「むかつき駆動」らしい。一方、人生というのは基本的に前進するほど問題が増えるので、むかつく→対応→別なことにむかつく→対応→……。


たぶん「むかつき駆動」はハッカーの定義なんかにも重なるんだと思う。でも僕はもちろんハッカーではない。むかつくポイントが彼らとは異なると思われるから。たとえば、計算機に仕事をさせられていることにむかつくことはなくて、計算機を使えていない自分にむかつく。よく言えば客観的だけど、ええかっこしいなのかもしれない。だとしたらむかつく。でもええかっこしいかもしれない自分にむかついて誤った対応（自分の外面に無頓着になるとか）をすると女の子に嫌われそうなのでやっぱりむかつく。むかー☆

開始タグと終了タグで構造化されているテキストがあって、しかも同じ種類のタグが入れ子になっていたら、どうやって一番外側のグループを取り出すのが定石なんだろう。『詳解 正規表現』には何かカッコいい方法が書いてあるんだろうか。

とりあえず問題をブレークダウンすると、こんな風に入れ子になっているパターンを正規表現でうまく補足できないかなあという話。

gosh> str
"<p>This is a paragraph.
<footnote><p>Here is a paragraph in the footnote</p></footnote>
Here is a main paragraph again.</p>"

gosh> ((rxmatch #/うまいパターン/ str))
"<p>This is a paragraph.
<footnote><p>Here is a paragraph in the footnote</p></footnote>
Here is a main paragraph again.</p>"

もちろん、これじゃ困るわけ。

gosh> ((rxmatch #/<p>.*?<\/p>/ str))
"<p>This is a paragraph.
<footnote><p>Here is a paragraph in the footnote</p>"

結論。一晩寝ても「うまいパターン」は見出せなかった。というわけで、正規表現ではなくGaucheでなんとかする方向へ逃げる。

戦略としては、こんなでどうか。

1. 開始タグをみつける。
2. 開始タグから最初にみつけた終了タグまでを match 候補にする。（その途中で開始タグを見つけるかもしれないけど気にしない）
3. match 候補のなかの開始タグと終了タグの数を調べる。同じなら match 候補を match にして終了。違ったら4.へ。
4. match 候補を開始タグとみなして2.へ。

実装。

; matche to the broadest range sandwiched between two patterns
(define (rxmatch-between-pattern pattern1 pattern2 string)
  (define (make-pattern pattern-string1 pattern-string2)
    (string->regexp
     (string-append pattern-string1 ".*?" pattern-string2)))
  (define init-pattern
    (make-pattern (regexp->string pattern1) (regexp->string pattern2)))
  (define (num-of-matched-inner pattern string)
    (let R ((head-matched (pattern string)) (n 0))
      (if (not head-matched)
          n
          (R (pattern (rxmatch-after head-matched)) (+ n 1)))))
  (let R ((matched (init-pattern string)))
    (if (not matched)
        #f ;; There's no match -- REGEXP-BETWEEN-PATTERN"
        (if (= (num-of-matched-inner pattern1 (matched))
               (num-of-matched-inner pattern2 (matched)))
            matched
            (R ((make-pattern (regexp-quote (matched)) (regexp->string pattern2)) string))))))

これの問題点は、異常に長いグループがあった場合に Gauche の "regexp too large." エラーが出ることだ。はてどうする？

おとといの anagram は、できるだけ奇妙な reverse を考えているときに気がついた。

(define (my-reverse ls)
  (append (if (null? (cddr ls))
              (cdr ls)
              (my-reverse (cdr ls)))
          (list (car ls))))

むかしむかし reverse に悩んでいたのは、もう2年も前なのか。

回文を作りたい。いや、別に回文を作りたいわけじゃないんだけど、こういう再帰もできるのかと今頃気がついてなんとなく楽しくなった22時。

(define (anagram ls)
  (append (list (car ls))
          (if (null? (cddr ls))
              (cdr ls)
              (anagram (cdr ls)))
          (list (car ls))))

gosh> (anagram '(ABLE WAS I ERE))
(ABLE WAS I ERE I WAS ABLE)

例文は『On Lisp』より。

連番を作るのに integ のようなプロシージャを使うのはいいけど、Schemeでは引数の評価順が規定されていないので連番の順序はどうなるか保証はないよという話。次のようなコメントをいただいたので、これを復習してきちんと消化しよう。

ところで、

gosh> (list (integ) (integ) (integ))
(1 2 3)

は，R5RSには引数の評価順が規定されていないので，これが
(3 2 1)になっても文句はいえないと思う:) 

そういえばSICPの第3章にもそんな問題（ex. 3.8）があった。評価順が左→右の実装では (+ (f 0) (f 1)) が 0 だけど、右→左の実装では 1 になるような f を定義しろという問題。

その昔、この問題を解いたときに定義したのはこんなグローバル変数を使った方法だった。

(define y 0)
(define (f x)
  (if (= y 0)
      (begin (set! y x) 0)
      (begin (set! y 1) y)))

これはダサい。いまならこう書く（えらそう）。

(define f
  (let ((y 0))
    (lambda (x)
      (if (= y 0)
          (begin (set! y x) 0)
          (begin (set! y 1) y)))))

さて、ふつうの実装は左→右で評価するので、これを試すには右→左で評価してくれる実装が必要だ。まあ、この問題だけなら引数の順番を入れ替えて (+ (f 0) (f 1)) と (+ (f 1) (f 0)) を Gauche で試せばいいんだけど、せっかくSICPの第4章でメタ言語評価器（つまりSchemeで定義するSchemeのインタプリタ）を作るので、それを右→左で評価するように改造して使うことにする。それに、ex. 4.1が、まさにそのように改造せよという問題だ。ここではletも必要なので、letを追加したdata-directed スタイルのバージョン（つまりex. 4.3と4.6の成果を取り込んだもの）を使う。たぶんここら（SICP Web Site for the Japanese Edition）あたりにもあると思うけど、オレ実装は以下（getとputが必要）。

metacircular-evaluator-right-to-left.scm

gosh> 
(define f
  (let ((y 0))
    (lambda (x)
      (if (= y 0)
          (begin (set! y x) 0)
          (begin (set! y 1) y)))))
f
gosh> (+ (f 0) (f 1))
0
gosh> (driver-loop)

;;; M-Eval input:
(define f
  (let ((y 0))
    (lambda (x)
      (if (= y 0)
          (begin (set! y x) 0)
          (begin (set! y 1) y)))))

;;; M-Eval value:
ok

;;; M-Eval input:
(+ (f 0) (f 1))

;;; M-Eval value:
1

もちろん(list (integ) (integ) (integ))も文句を言えない結果に。

;;; M-Eval input:
(list (integ) (integ) (integ))

;;; M-Eval value:
(3 2 1)

call/ccは「引数を1つとる関数」である。
call/ccは「引数を1つとるプロシージャを1つ引数にとる関数」である。
ということは、call/ccにcall/ccを引数として与えられる。

(call/cc call/cc)

これは何か。

おさらいから。call/ccは引数を1つとるプロシージャを引数にとる。

(call/cc (lambda (k) ...))    ; (A)

これをなんとなく評価してみると、内側の(lambda (k) ...)に適当な引数を与えて評価されたかのような結果が得られる。

gosh> (call/cc (lambda (k) 1))
1
gosh> (call/cc (lambda (k) (odd? 1)))
#t

このときの適当な引数が継続である。つまり、(A)を評価するとそのときの継続を引数にして内側の(lambda (k) ...)が評価される。これがcall/ccという名前の関数の動作だ。

では、そのときの継続（適当な引数）ってのが具体的に何であるかを考えよう。実際に内側の(lambda (k) ...)でkを返すようにしてみても、あまり有効なヒントは得られない。

gosh> (call/cc (lambda (k) k))
#<subr continuation>

そこで、call/ccの引数であるプロシージャのなかで、kを適当なグローバル変数に代入してみる。

gosh> (define c '())
c
gosh> (call/cc (lambda (k) (set! c k) k))    ; (B)
#<subr continuation>
gosh> (c 100 "abc" (odd? 1) (display (/ 5 2)) (display "\n"))
2.5
100
"abc"
#t
#<undef>
#<undef>

どうやらcは、任意の引数をとってそれを評価するプロシージャみたいに機能している。しかしcはプロシージャではない。cとeq?の意味で同じオブジェクトであり、かつ(B)が返すはずのkも、やはりプロシージャではない。だから、こんなふうに適用することはできない。

gosh> ((call/cc (lambda (k) (set! c k) k)) 1)    ; (C)
ERROR: invalid application: (1 1)

(C)からは、kがプロシージャでないことを納得する以上に興味深いことがわかる。もしcall/ccが内側のlambdaを評価しているだけなら、(C)のように実行してエラーが返ったところで、cには(B)を評価したときと同じような動作をするオブジェクトが代入されているはずだ。ところが結果は次のとおり。

gosh> (c 100)
ERROR: invalid application: (100 1)

どうやらc（つまりk）は、外側のcall/ccがどういう文脈で評価されたかを知っている。そしてSchemeでは、そういうオブジェクトを継続と呼んでプロシージャ並みに自由に扱うことができる。

(C)の場合、call/ccの返すオブジェクトは、引数の位置に数字の1をともなって評価されようとしている((call/cc ...) 1)、引数自身(lambda (k) ... k))だ。
だから、(C)は「引数の位置に数字の1をともなって評価されようとしている数字の1」だし、(c 100)は「引数の位置に数字の1をともなって評価されようとしている数字の100」だ。いずれもエラーになって当然。

ちなみに、cは「引数の位置に数字の1をともなって評価されようとしている……」なので、次のようにcを評価すればエラーにならない。

gosh> (c (lambda (x) 1))
1
gosh> (c (lambda (x) 100))
100

もちろん最初から同様にやることもできる。

gosh> ((call/cc (lambda (k) (set! c k) k)) (lambda (x) 1))    ; (D)
1

(lambda (x) 1)とかを引数にしている限り、cの動作もあんまり変わらない。

gosh> (c (lambda (x) 1))
1
gosh> (c (lambda (x) 100))
100

しかし、この見た目に惑わされると道を見失う。(D)の結果cは「引数の位置に数字の1を返す1引数プロシージャをともなって評価されようとしている……」になるので、先のcとはまったく異なるものだ。今度のcには、「1引数プロシージャを引数にするプロシージャ」を適用できる。

gosh> (define apply100
        (lambda (proc)
          (proc 100)))
apply100
gosh> (c apply100)
1

くどく書けば、(c apply100)は「引数の位置に数字の1を返す1引数プロシージャをともなって評価されようとしているapply100」だ。だから1が返る。

ところで「1引数プロシージャを引数にするプロシージャ」は、わざわざapply100みたいなのを定義しなくても身近にある。call/ccだ。ということは、次の式もきちんと評価されるし、その結果もここまでくれば明らかだよね。

gosh> (c call/cc)
1

さて。

冒頭に書いたように、call/ccは引数を1つとるプロシージャを引数にとる。そこで今度は、さっき定義したapply100を使って次の式について考えてみよう。

(call/cc apply100)    ; (E)

apply100は、「引数を1つとって、その引数をプロシージャとして、そのプロシージャの引数には数字の100を束縛する」。したがってcall/ccから見ると、「call/ccを呼んだときの継続に数字の100を適用する」。トップレベルで(E)を呼べば、そのときの継続は「評価して返す」というREPLの基本動作だけなので、100が返る。

gosh> (call/cc apply100)
100

ところで「引数を1つとるプロシージャ」は、わざわざapply100を使わなくても身近にある。call/ccだ。ということは、次の式もきちんと評価される。

(call/cc call/cc)    ; (F)

call/ccは、「引数を1つとって、その引数をプロシージャとして、そのプロシージャの引数にはそのときの継続を束縛する」。したがって左のcall/ccから見ると、「左のcall/ccを呼んだときの継続に右のcall/ccを呼んだときの継続を適用する」。トップレベルで(F)を呼べば、そのときの継続は「評価して返す」というREPLの基本動作だけなので、右のcall/ccを呼んだときの継続が返る？

gosh> (call/cc call/cc)
#<subr continuation>

右のcall/ccを呼んだときの継続って何？（結局疑問形で時間切れ……）

先月、連番を作るのにintegというプロシージャを定義して喜んでいたら、素直な方法はこれだという指摘をいただいた。ありがとうございます。

(define integ
  (let ((n 0))
    (lambda ()
      (set! n (+ n 1))
      n)))

なるほど。これはきっともう一度"Seasoned Schemer"を読み直すべきだな。

ところで、こういうクロージャをSICPの第3章の評価モデルで表すとどうなるんだろう。
まず考えやすいようにletをlambdaに変換して、

(define integ
  ((lambda (n)
     (lambda ()
       (set! n (+ n 1))
       n))
   0))

nが0に束縛された環境以下でset!が機能するのだから、こんな感じでいいのだろうか？

『On Lisp』を読んでいると、これはLisperのためだけの本にするのはもったいないなあと強く感じる。
LisperじゃないとLispのコードが読めないので結局Lisperにしか読めないという制限はあるけど、Paul Grahamが書いていることの基底にはもっと普遍的な内容がある。
だから、『ハッカーと画家』としてまとめられたようなエッセイを通して、非Lisperであっても彼の思想に触れられるのはありがたいことだと思う。

とはいえ、『On Lisp』に書かれている表面的なこと、つまり「マクロ」がどうでもいいかというと、そんなことはまったくない。
「マクロがあるLispは最強」を超訳して対偶をとると「人手で繰り返すような作業を効率化できないシステムは屑」になる。
本当？
Paul Grahamは、マクロという仕組みが特筆すべきものであり、それがLispという道具を最強にしていると言っていると思うので、どんな道具であれ自分の使っている道具に適切なオレマクロレイヤを組み入れればそれなりに強力にできるよね、という意味で本当。

ここ1～2年くらいの仕事では、原稿の文章構造（XMLだったり簡易的なタグがつけられた平文だったり）をLaTeXに変換して印刷所に渡すPDFを生成するようにしている。
つまり、旧来のようなMacintosh上でのDTPソフトを使った組版作業を捨てている。Macintosh上でのDTPソフトを使った組版作業の何が悲しいかっていうと、だいたい技術書の原稿なんておなじような構造を持っているのに、それを毎度毎度人間が手作業でDTPソフト上に「絵」としてレイアウトしなきゃいけないとこ。ここで「毎度毎度」というのは、別の新しい本を作るたびだけじゃない。1冊の本の制作においてさえ、原稿に修正が入るたびに「絵」を描きなおす作業を繰り返さなければいけない。

そんな三途の川で石を積み上げるような地獄から抜け出るのに必要なのは、まさにマクロ。TeXのマクロがその地獄から解放してくれる……ただし編集者を別な地獄に陥れるという方法で。前の地獄が虚しさに起因するとしたら、今度の地獄はマグマ溜まりに架かったつり橋を歩かされるみたいなものだ。いつ足を滑らせて丸焦げになるかわからない。

おなじ歩くなら石橋を渡りたいので、TeXしかなかったらTeXのマクロで処理せざるを得ない処理の大部分を、TeXからは切り離してGaucheで実現しているのが現在の制作方法だといっていい。つまりマクロの層をGaucheで提供するってこと。原稿の文章構造をGaucheでLaTeXのコードに展開し、それをpLaTeXで処理するわけだ。これだけでずいぶん歩きやすくなる。LaTeXの実行時にしか知りえない情報（ページの幅とかテキストの大きさとか）にかかわる部分は本質的には扱えないけど、それも汎用を目指さなければ抜け道がないわけではない（文字数や文字の大きさを書籍ごとに決めうちすることで擬似的に代用できる）。

『On Lisp』を読んでいてびっくりしたのは、この方法が見た目にも『On Lisp』のマクロに近いということ。マクロの言語（Gauche）とコンパイルの言語（LaTeX）が異なるという大きな違いはあるけど、Gaucheが採用している文法のおかげで、ただのテキスト処理のコードなのに見た目がCLのマクロっぽくなる。たとえばTeXの環境を定義するにはこんなコードを使っている。

(define (make-tex-env env-name opt-arg args)
  (let ((arg-list (string-join (map x->string args) "}{")))
    (define-tag-process
      env-name
      (lambda (parent)
        (if (not (should-not-linebreak? parent))
          (display "\n"))
        (display #`"\\begin{,env-name}")
        (if (not (equal? opt-arg ""))
            (display #`"[,opt-arg]"))
        (if (not (null? args))
            (display #`"{,arg-list}"))
        (display "%\n"))
      (lambda (string parent) (display-without-white (kick-comment string)))
      (lambda (parent) (display #`"\\end{,env-name}%\n")))))

テキストリテラルのあたりに見える「,」や「`」がCLのマクロっぽさをかもし出しているように感じるのは僕だけ？ これらはGaucheでテキスト処理に採用している文法だと理解しているんだけど、それがいかにセンスのいい選択であるのか、On Lispを読んで初めて気付いた。すごいよGauche。（ちなみにdefine-tag-processは入れ子になった文章構造を再帰的にTeXに変換するコードに渡すためのクロージャとして定義したもの。）

ところで、こういう「スクリプトで原稿をLaTeXに変換→PDFにコンパイル」という制作方法について、去年のはじめくらいまでは子供だましみたいだなあと卑下していた。
それは殊更に困難もなく目指すものが実現できてしまっていたからなわけだけど、困難なく実現できたのは、こういう優れたセンスのGaucheという処理系や周囲の諦観交じりの援助（とくにCさん）があったからに過ぎないわけで、感謝すると同時に、じゃあ僕にはその返答として何ができるんだろう？ 本当はここでTeX界隈にも深く感謝すべきだと理解はしているけど、結局ぶーぶー言いながらTeXを使わざるをえない地獄にあえいでいる現状には満足すべきでないと思うので、自戒をこめてスルー。

なんだか『On Lisp』とは関係ない話になってきた。とにかく日本語版の『On Lisp』は、いま主編集者のhisashimさんが最後の追い上げをかけているので、早ければ3/24の週末には大きな書店で入手できるはずです。

先月だかその前だかにBloggerをβから正規版に乗り換えたところ、コメントのお知らせメールの転送が止ってしまって、いただいた希少なコメントに気付くのが遅くなってしまった。すみません。そのうえ、これまでつかっていたatom-blogger.elが使えなくなっちゃったので、更新するのがやたらに面倒。結局2月は1件しか書かなかったのか。

反省して、まずは新しいBloggerのEmacsクライアント（g-clientというらしい）を導入する。

An Emacs Client For Blogger
http://buzz.blogger.com/2007/03/emacs-client-for-blogger.html

上記ページの手順で英語の記事はうまくいくんだけど、日本語の記事はうまくアップできないようだ（つまり、このエントリはg-clientではアップしていない）。

あと備忘録。そのままでは毎回atomのURLを入力しなければならず使いにくいので、将来インストールしなおすときはmakeの前にgblogger.elを編集するのを忘れないこと。

(defun gblogger-new-entry (url)
  "Create a new Blog post."
  (interactive
   (list
    (let ((url (read-from-minibuffer "Post URL:")))
      (cond ((string= url "")
             "http://k16ex\.blogspot\.com/feeds/posts/default")
            ((string= url "note")
             "http://k16journal\.blogspot\.com/feeds/posts/default")))))
  (declare (special gblogger-auth-handle gblogger-new-entry-template
                    gblogger-generator-name gblogger-publish-action))
  (g-auth-ensure-token gblogger-auth-handle)
  (let* ((title (read-string "Title: "))
         (buffer (get-buffer-create (if (string= title "") "temp" title))))
    (save-excursion
      (set-buffer buffer)
      (erase-buffer)
      (gblogger-mode)
      (setq gblogger-this-url url)
      (goto-char (point-max))
      (insert
       (format gblogger-new-entry-template
               gblogger-generator-name gblogger-generator-name
               gblogger-author title)))
    (switch-to-buffer buffer)
    (setq gblogger-publish-action 'gblogger-post-entry)
    (search-backward "<div" nil t)
    (forward-line 1)
    (message
     (substitute-command-keys "Use \\[gblogger-publish] to publish your edits ."))))

答えはわかってるっていう問題は少なくない（実際、答えは42だ）。
問いをはっきりさせるのに抽象化が必要なんだと思う。

連番を作りたい。ようするに、こんな動作をするプロシージャintegがほしい。

gosh> (list (integ) (integ) (integ))
(1 2 3)

まあ、グローバル変数を破壊的に更新すればいい。

(define n 0)
(define (integ)
  (set! n (+ n 1))
  n)

でもそんなSchemeコードはいやだ。主に気分的な理由で。こういう問題にはcall/ccを使うのがオレブーム。

(define (integ)
  (let R ((n 0))
    (call/cc
      (lambda (k)
        (set! integ (lambda () (R (+ n 1))))
        (+ n 1)))))

しかしこれではcall/ccの意味がまったくありませんでした。すみません。以下で十分です。

(define (integ)
  (let R ((n 0))
    (call/cc
      (lambda (k)
        (set! integ (lambda () (R (+ n 1))))
        (+ n 1)))))

気を取り直して。応用。

(let R ((str "hello hello hello hello"))
  (rxmatch-if (rxmatch #/ / str)
      (space)
    (R (regexp-replace space str #`",(integ)"))
    str))

=> hello1hello2hello3hello"

Gaucheに用意されているregexp-replace-allという便利な関数と組み合わせると編集者にとってはプチよろこばしい。

gosh> (regexp-replace-all #/ / "hello hello hello hello" (lambda (m) (integ)))
"hello4hello5hello6hello"

ところでintegを次のように定義するとうまくいかない理由を昨日から考えているんだけど、わからない。これでもとくに問題なさそうなんだけど、(list (integ) (integ)) のように実行しても1つめの(integ)が評価されるだけ。

(define (integ)
  (call/cc
    (lambda (skip)
      (let R ((n 0))
        (call/cc
          (lambda (k)
            (set! integ (lambda () (k '())))
            (skip (+ n 1))))
        (R (+ n 1))))))

おれカネゴンさんの一言をきっかけに、ひさしぶりにコンサートに行ってきた。去年はひとつも行かなかったなあ。

東京都交響楽団 第638回定期演奏会　Aシリーズ
http://www.tmso.or.jp/j/concert_ticket/detail/index.php?id=3024

こちらで絶賛されている松村禎三の「ピアノ協奏曲 第1番」は聴いたことがなかったけど、生で野平一郎の協奏曲ソロが聴けるということで、すぐにチケットを手配。オネゲルの5番が「生で」聴けるというのも即決したポイント。ミヨーも聴いたことないけど、まあ、ミヨーのオーケストラ曲は僕にとってどれも似たような印象だからハズレはありえないだろう（これは賛辞です）。幸い（主催者側にとっては残念ながら）、席は豊富に残っていた。もう1週間前なのに。野平なのに。

当日、会場は予想どおり空席が目立つ。ぼくは3階だったので、開宴前に上からぼうっと下を見ていると、おじいさんが車椅子で会場に。よくみると松村禎三本人で、やるせなさがこみあげる。この演目だから客が入らないというより、たぶんぼくのような潜在的な客を逃しているのが大きいんだろう。実際、ぼくも公演の存在すら知らなかった。

演奏については、まず、この公演に足をはこぶきっかけを与えてくれた「新しい世紀のための音楽」のレビューを。

ぼくには、松村禎三の2曲はどちらも文句のつけどころがなかった。とくに「管弦楽のための前奏曲」では、CDで聴いて知っていた以上にピッコロ6本がからみあう迫力がすごくて鳥肌もの。「ピアノ協奏曲第1番」は、もう、やっぱり野平さんすげー。苦労している様子は少なくとも僕には感じられなかった。はじめて聴いた曲だけど、竹薮がざわざわしているようなピアノソロの冒頭になつかしい印象を受けるのは松村禎三本人がいっているところの「アジア的な群」というやつにアジアで生まれ育った人間として共感するのでしょうか。よくわかんないけど。とにかく、それからピアノが次第に高揚していって、気づいたらオーケストラがうねりながらからんでいる。自然科学的には風がふいて竹薮がざわめくはずなのに、竹薮がざわめくことで空気をゆらし風を巻き上げているみたいな。そういううねりが2回くらい繰り返され、冒頭のようなピアノソロのざわざわで静かに終わる。この協奏曲は、ほんとうにすごいや。その世界感をきちんと提示してくれた都饗と指揮の下野さん、野平さんの演奏ではじめて曲を聴くとができてよかった。この協奏曲はストラビンスキーとバルトークと前期ケ−ジの好きな全世界の人に心からおすすめ。

後半はミヨーとオネゲル。ミヨーは誰がやっても同じようにハッピーになると思うのでいいとして（これは賛辞です）、オネゲルの5番は最後になって管がちょっとばて気味に感じられた。第1楽章はとてもよかったけど、それも中盤で弦による主題を背景に木管がタリラータリラーってするとことか、だいぶ弦に潰されてしまっていた感じ。第3楽章のラストになると、みんなちょっぴりぐだぐだ。でもとてもよい演奏会だった。C席3500円でこれだけ楽しめるとは。こんな構成はあまりないだろうけど、都饗の定期演奏会はこれからもチェックするようにしよう。

常識なのかもしれないけど……

LaTeXのリストの体裁を制御する変数（『The LaTeXコンパニオン』の72ページに書いてあるやつ）のうち、リスト全体の上下のアキを制御する変数がなぜか3種類ある。

• \topsep
• \parskip
• \partopsep

この違いが本を読んでもよくわからない。本の解説によると、\topsepは「最初の項目と続く段落との空き」で、\partopsepは「環境が新しい段落を始める際に、\topsepに追加される余分な空き」で、\parskipにいたっては説明すらない。

経験的に知っていること。

\topsep

本文とリストの上下の余白の高さ。つまり、リストが入れ子になっているような場合には、\topsepの値がどうであろうと内側のリストの上下には余白ができない。

\parskip

リストの上側には、\parskipで指定したぶんだけ余分に空きができるようだ。下側には空きができない。入れ子のリストの内側でも同じ挙動。

\partopsep

リストの上下の余白の高さ。入れ子のリストの内側でも同じように余白ができる。

間違っていたら訂正したいので教えてください。

ついに歯ぐきに穴をあけてインプラントの支柱を埋め込んだ。抜歯は来週。しばらくまともなものが食べられないうえに感染症予防のための抗生剤でぼうっとする。でも明日は出社か。はたらきたくないよう。

奥様は仕事だし自転車にのる気力もない日曜なので、有限状態機械ごっこをしてひまをつぶす。とはいえ、遷移図を睨んでいても頭が弱くてちっとも理解がすすまないので、有限状態機械の動作を模倣する評価機をSICPの第4章を参考にしてつくってみよう。ザ 本末転倒。

(define (q0 input)
  (cond ((= input 0)
         (output 0)
         (transit! q0))
        ((= input 1)
         (output 0)
         (transit! q1))))
(define (q1 input)
  (cond ((= input 0)
         (output 1)
         (transit! q0))
        ((= input 1)
         (output 1)
         (transit! q1))))

(define (output b)
  (display #`"Output: ,b"))
(define (eval-in-current-state input state)
  (state input))
(define current-state q0)
(define (transit! q) (set! current-state q))

(define (fsm-loop)
  (newline)
  (let ((input (read)))
    (let* ((state current-state)
    (output (eval-in-current-state input state)))))
  (fsm-loop))

q0とq1は、いわゆる遅延機械。

gosh> 
(fsm-loop)



1

Output: 0

1

Output: 1

1

Output: 1

1

Output: 1

1

Output: 1

0

Output: 1

0

Output: 0

0

Output: 0

0

Output: 0

1

Output: 0

1

Output: 1

0

Output: 1

1

Output: 0
……

奥様が「お行」のピアノ曲を聞きたがっていた。「お行」ってなんだ、と聞くと、ロロロロロ……とかポポポポポ……とかで擬音化できるような曲だという。一般にピアノの音の擬音化は「ポロロン」みたいな感じなので、だいたいどの曲も「お行」なんじゃないのか? しかし、どうやら違うらしい。僕がいつも聞いているピアノ曲は、彼女にとってキョキョキョキョキョ……とかリリリリリ……なんだと。つまり「い行」か。

とりあえず彼女がイメージ先行で選んできた「お行」のCDはショパン。なんだ、そういうのでいいのか。つまり、比較的耳にやさしい音がほしいってことね。そこでブレンデル先生のモーツァルトのソナタを渡したら、案の定、求めていたものに合致したようだ。彼女の脳でキョとかリに聞こえるのは、きっとナンカロウとかメシアンなんだろう。たしかに鋭い音が跳ねっ返っているような雰囲気が「い行」に聞こえてきたよ。面白いのはドビュッシーなんかも「い行」系列にくくられていること。方法論は独自だけど結果的に納得できるカテゴライズがなされていることに驚く。その後の実験的な推測により、僕が聞きたい音と彼女が求めている音のぎりぎりの交わりは、シューベルトの後期ソナタ付近にありそうだということがわかった。

残念ながらうちには「お行」系列のまっとうなCDがたいへん少ないので、すこし補充するかなあ ← 結局CDが買いたい。

整数からなるリストを、指定した自然数の正値をスタートタグ、負値をクローズタグとみなしてグループにくくりたい。ただし、そのようなグループはリストは入れ子になっているかもしれない。

ようするに、こんなふうな結果を得たい。

gosh> test-list
(2 5 3 0 9 1 9 4 -1 9 4 2 1 0 1 9 -2 -1 5 1 -1 4 -1)
gosh> (group-between test-list 1)
(2 5 3 0 9 (1 9 4 -1) 9 4 2 (1 0 (1 9 -2 -1) 5 (1 -1) 4 -1))

condでグループにくくりながら再帰が基本的な戦略だけど、入れ子になっているかもしれないので工夫が必要になる。これには、一番内側にあるグループをくくり出すという操作を、指定した数がリストの表面に見えなくなるまで再帰すればよさそう。そこで、指定した数の正値が連続したら、いったんグループわけを始めたところに戻ってやり直すようにする。そこで call/cc ですよ。←関係ない（2007/5/18追記）

(define (group-between ls n)
  (define (group-most-inner ls)
    (cond ((null? ls)
            '())
          ((eq? (car ls) n)
           (call/cc
            (lambda (k)
              (let R ((first (list (car ls)))
                      (rest (cdr ls)))
                (cond ((null? rest)
                       (error "pair unmatched" n))
                      ((eq? (car rest) (- 0 n))
                       (k (cons (append first (list (car rest)))
                                (group-most-inner (cdr rest)))))
                      ((eq? (car rest) n)
                       (k (cons (car ls)
                                (group-most-inner (cdr ls)))))
                      (else
                       (R (append first (list (car rest)))
                          (cdr rest))))))))
          (else
           (cons (car ls)
                 (group-most-inner (cdr ls))))))
  (cond ((not (member n ls))
         ls)
        (else
         (group-between (group-most-inner ls) n))))

これを応用して、XMLやHTMLの文書から要素を取り出してくるのに使えそう。構造だけ欲しければsxmlにしてしまえばいいけど、元の文書の「見た目」を変えずに特定の要素だけいじるときには役立つかも。

男性の性欲は男性の自信と関係しているという説を最近きいたけど、ほんと? そういうもっともらしい意見を女性が信じちゃうと、性欲とかどうでもよくてとにかくかわいい女性が大好き、っていう人間が生きにくくなるので困るんですが。


みんな本当は性欲とかどうでもよくて、単純に女性と一緒にいると楽しくて、でも性的ないいわけがないと照れるから、しかたなく風俗とかいくんじゃないのか。風俗にいったことがないので推測しかできないけどさ、女の子どうしできゃっきゃって楽しそうにしてるのが羨ましくて羨ましくて、いっそのこと自分も女の子になって混ざりたいなあっていう男性の本音を歪めて提供するのがエロ産業なのではあるまいか。

自転車のタイヤのバルブカバーを盗まれた。走行に支障はないとはいえ、腹がたつ。この手の犯罪はとにかくたちが悪い。やられ損だ。仮に犯罪が発覚しても犯罪者にとってたいした不利にならない。社会的なリスクも対して大きくないから、倫理感がない限り手を染めるほうが得策なんだろう。古今東西、不条理な大人の制裁がない社会で中高生がいきがるのは、これが理由にちがいない。

ハムラビ法展でさえ、たかだか受けた犯罪と同じ報復（懲罰）しか認めない。これはフェアじゃない。最初に目を潰された被害者のほうは、そもそももともと目なんて潰されたくなかったわけで、たまたま犯罪に合うようなことさえなければ幸せに暮らしていられたはず。一方、目を潰すほうには選択肢がある。相手の目を潰したところで高々自分の目を潰されるだけだから、それを覚悟して犯罪により得られるメリット（遺恨を晴らすとか）のほうが大きければ、犯罪のほうを選択できるわけだ。ずるい。

復讐法で対等に扱うべきなのは犯罪そのものの程度ではなく、犯罪により被る被害の程度であるべきだ。だって、仮に自転車のバルブを盗んだやつが僕の前に現れてバルブを返してくれた上に「俺の自転車のバルブをお前が盗んでもいいぜ」と言ってきたとして、僕はそいつの自転車のバルブなんて全然盗みたくないし、それで僕の今の憤慨とか悔しさはとうてい補填できない。かといって、そこでそいつを殴りつけて今の僕と同等の憤慨を感じさせることに成功しても、それで僕は警察に捕まって刑事裁判を受けて刑に服し、いま以上の不快感を味わうことになる。それじゃあやっぱり不公平だ。どうする?

ポイントは、法律にのっとった刑罰の度合が比較的線形に緩やかに厳しくなるのに対し、僕が相手に与えることが可能な苦痛はより急峻に厳しくできるというところにある。だって、そこでカッとなってそいつを殺害したところで、いまみたいな事情なら極刑にはなりそうもない。つまり、相手を殺害するまで至れば、確実に僕のほうが被害の程度が小さくなる。どのへんに損益分岐点があるかはさだかじゃないけど、妄想ではタコ殴りにして半身不随にするところくらいになる気がする。その程度であれば、こっちも懲役10年程度でかつ残りの一生を棒にふるだろうし、相手も一生を棒にふるだろうから、きっとイーブンだ。被害の程度を平等にするという精神にのっとればそれくらいが妥当だってことだ、ざまみろ。どんな犯罪も、せめてそれくらい殺伐とした覚悟でやってもらいたいものである。

頭に血が登っているので適当なことを書いちゃったけど、「自転車のバルブの盗難」を「家族の傷害事件」とかにしたら、それほどふつーの人情とかけ離れていないような気がしてきた。もし家族がそのへんのガキから傷害事件を被ったら、僕は犯罪者と被害の程度が同じになるようにがんばるかもしれない。

現代音楽は抽象的だといわれることが多い。だからわけがわからんと。確かにそういう面はある。


とりあえず何が現代音楽か定義せずに話をすすめるけど、クラシック音楽のいいところは、作曲家のほかに演奏家という存在がコンテンツのオーソリティーとして認知されていることだと思う。音楽を聴くほうにしてみれば、たとえ作曲家の言っていることが強烈すぎてちんぷんかんぷんでも、あるいは稚拙すぎて退屈でも、演奏家というフィルターを通して楽曲に接することができる。ようするに、どんな曲でも演奏家しだいでコンテンツとして成立できるってことだ。Pollini や Boulez を見れば、ここまではあながち間違っていないはず。ただし彼らの演奏が秀でているのは、それが一般人ウケするようなフィルターだからじゃなくて、譜面を読み込んで忠実な解釈を徹底していることにある。だから楽曲の質が大きく影響しているはずなんだけどつまらない曲もキラキラしちゃうから不思議。閑話休題。


彼らのすごさはおいといて、技術書というコンテンツも同じことが言えなくちゃだめだよなあと思う。譜面と演奏の関係が、原稿と編集の間に成り立つのか、それとももっとメタレベルで技術と書籍の間に成り立つのかは知らない。たぶん両方なんだろう。

call/ccについておまえの知っていることを晒せと脅された。

まずこんな式を考える。

(begin 
  (print "hello")
  (print "goodbye")
  (print "hello again")
  (print "goodbye again"))

この式を評価すると、beginの中の環境で(print ...)という式が上からじゅんばんに評価される。結果的にこう出力される。

=>
hello
goodbye
hello again
goodbye again

Schemeでは、式の1つめの要素をオペレータとみなし、残りをオペランドとみなす。Schemeで式を評価するっていうのは、各オペランドを評価したものを引数として、それらをオペレータに適用することを意味している。

上記の例の(begin ...)という式を評価する場合、beginプロシージャに対してオペランドである(print ...)たちを評価したものが適用される。beginは引数として与えられた式を順番に評価していくプロシージャなので、まずどんな動作をするかというと、「(print "hello")を評価した。これから残りの(print ...)たちをbeginに適用する」。

で、この動作を記録にとっておくことにしよう。具体的にはスタックにつむことにする。

(print "hello")を評価した。これから残りの引数を評価する

同様に次の動作もスタックにつむ。

top    : (print "hello")と(print "goodbye")を評価した。これから残りの引数を評価する
bottom : (print "hello")を評価した。これから残りの引数を評価する

これを繰り返すと、beginの評価が終ったときのスタックの状態はこうなる。

top    : (print "hello")と(print "goodbye")と(print "hello again")と(print "goodbye again")を評価した。最後の式の値を返すよ
         (print "hello")と(print "goodbye")と(print "hello again")を評価した。これから残りの引数を評価する
         (print "hello")と(print "goodbye")を評価した。これから残りの引数を評価する
bottom : (print "hello")を評価した。これから残りの引数を評価する

じつはこの活動記録が「継続」を表している。で、スタックなので通常はいちばん上しか見えないけれど（つまり最後の式の値が返るだけ）、Schemeには途中を捕まえる方法がある。それがcall/cc。

(define c '())
(begin 
  (print "hello")
  (print "goodbye")
  (call/cc
    (lambda (k) (set! c k)))
  (print "hello again")
  (print "goodbye again"))

こうすると、call/ccを仕掛けた場所の継続、つまり、くだんのスタックの下から2番目を捕まえて、あらかじめ適当な値で定義しておいたcに代入できる。けっきょくcには、「(print "hello")と(print "goodbye")を評価した。これから残りの引数を評価する」という継続が代入される。そこでcを評価すれば、cは「これから残りの引数を評価する」つもりでまんまんなので、こうなる。

gosh> (c)
hello again
goodbye again

これを応用すれば、たとえば「(a b a c a d)というリストから、最後のaで始まる部分リスト(a d)を取ってくる」とか、「木構造を探索するのに、途中で分岐した場所から別の枝を探索し直す」とかできる。これらは「途中を忘れて覚えておいた場所からやり直す」という人生やりなおし機型の応用といえる。一方、「とにかくcall/ccを仕掛けた場所に戻れる」という性質を利用すれば、いわゆる局所脱出ができるようになる。具体的な例はディヴィグの本とか"Seasoned Schemer"とかを参照。そもそもこの記事は"Seasoned Schemer"のオレ解釈なわけで。

日本語の疑問文で「それとも」は、 or 条件だと見なしていいだろう。

Cさん：年賀状、出さないですよね？ それとも出しますか？
Kさん：うん

出すか出さないかしかないので、この問題の答えは常に true だ。コードにすれば一目瞭然。

(define send-card? (lambda () #f))  ; 出さないつもりでも……
(or (not (send-card?))
    (send-card?))

=> #t                               ; 答えは「うん」

ところが、実際にはこういう会話が成立する。

Cさん：年賀状、出さないですよね？ それとも出しますか？
Kさん：いや（出さない）

なんで排中率を放棄して false を返しているのか。
それは鳥頭だからであって、ひとつめの質問を忘れちゃってるだけだよね。

(call/cc
  (lambda (k)
    (or (not (send-card?))
        (k (send-card?)))))  ; 忘れた

=> #t                        ; ???

どうして call/cc で脱出せずに #t が返るの？

(define (trace ls)
  (call/cc
   (lambda (skip)
     (let R ((ls ls))
       (cond ((null? ls)
	      '())
	     (else
	      (call/cc
	       (lambda (k)
		 (set! trace (lambda () (k #f)))
		 (skip (car ls))))
	      (R (cdr ls))))))))

本当は好きなものを嫌いと言ってみることでアイデンティティを成立させようとしていた時期があったと思う。

たとえばクラシック音楽への興味は、メジャーな楽曲のメジャーなフレーズへの興味から入って、そのうちマイナーな作品の魅力に気づき、オレだけが知っている的な優越感とともにどんどんマイナーな作家/作品/演奏を指向していって、そのうちメジャーな作家/作品を否定するようになった。このメジャー否定は、小中学校の音楽の時間に超メジャーどころを強制的に視聴させられて感想文を書かされるような体験と調和して増幅した。もう、なんでこんな子どもっぽい曲を聴かなきゃいけないんだ、と。モーツァルト? ヴェーベルンでも聴かせろや。

で、高校生にもなるとクラシックなんかよりハードロックに目覚めるから、モーツァルトもヴェーベルンも忘れさる。モーツァルトを思い出すのはずいぶん年齢を経てからだ。そこで、なんでこれを否定してたんだろうと思って悲しくなる。モーツァルトを否定することで、オレはもっとディープな作品を聴いているんだという優越感を安直に手に入れようとしていたんだろう。

今思い出すと、本当はモーツァルトも好きだった。好きなものを好きと言えるようになるには、たぶんものすごい跳躍が必要だった。どこで飛んだか知らないけど、いまは自分の好き嫌いを社会とのかかわりでとらえなくてすむ場所にいる。生きやすい。

なんで突然こんな個人的なことを書きたくなったかというと、フジテレビで月曜日に放映している「のだめカンタービレ」が楽しくてしかたないから。自意識を一周してきて、ようやくこういうドラマを素直に楽しめるようになったんだなあ。

Allegro Common Lisp 2006 November Seminar (Japanese)。忘れないうちに3日間の印象を殴り書き。

Lispそのものに興味がある人たちと、むしろSemantic Technologyに興味がある人たちがいて、双方にとって有益なセミナーだったと思う。Franz Inc.と数理システムの皆さんには本当に感謝いたします。

いちばん興味深かったのは、Fritz（Franzの創業者）がGoogleに代表されるSyntacticな検索を明確に否定していたこと。非常に慎重な人なので、Googleのビジネスに対して不快感をあらわにしているのが意外だった。

そしてやっぱりAllegroGraphのすごさが印象的。というか、それを開発しているJansのパワーがすごい（懇親会では手羽餃子の油を背広に跳ね飛ばしてしまった。あらためてごめんなさい）。いくら理念的にSemantic Technologiesに利があるといっても、やっぱりRDFトリプルとして記述されたメタデータに対する操作を大規模なアプリケーションにまでスケールさせるのは困難なわけで、そのへんが軽量なスクリプト言語とXMLベースのWeb 2.0が成長した理由のひとつだろう。そういう事情をひっくり返してSemantic TechnologiesをWeb 3.0（そんなものがあるとして）の支柱にする鍵のひとつになりうるのかもしれない。まあ、そんな大仰なことを言わなくても、ふつうにRDBMSよりグラフのほうが直感的なデータベースは多いような気がする。実際、いままさに頭を悩ませている問題として、出版した書籍と著者や訳者とを管理できるようなデータベースがほしい。そんな出版社向けの汎用データベースをAllegroGraphで作るという夢を見た（著者と書籍の間に単純ではない関係があったりするので、ふつうの住所録を作るよりいくぶんたいへん）。

もうひとつの鍵はプレイヤーの数だと思うんだけど、これはちょっと悲観的にならざるをえない。Web 2.0でやっているのはSyntacticなデータから豊饒なWebアプリケーションを大人数でマッシュアップ（これって音楽業界のマーケティング用語じゃなかったの？）すること。Lispベースの技術でそれだけのジャンクなマンパワーを集められるかっていったら、たぶんできない。Lisp以外で同じことが実現できるようになるかっていたら、たぶんすぐにはできない。

でも、それでいいのかも。Fritzの不快感は「なんでもGoogle」という外野の風潮に対するものであって、それで満足する人はそれでいいけど不足があるならぜひ相談してくれ、という話だったんだと思う（かなりバイアスぎみ）。すでにSyntacticなキーワード検索というアプローチの限界が露呈している分野（バイオとIntelligence Agencies）はSemantic Technologiesに目を向けているし、ある程度大規模な組織の内部に閉じたアプリケーションなんかもSemantic Technologiesに目を向ける潜在的な市場になるとふんでいるらしい。まさに昨年のセミナーでは「Lispでなければ解決困難なほど複雑な問題も世の中にはたくさんある」と強調していたけど、その方法論をSemantic Technologiesに絞ってきたんだなあ、という印象だった。

なによりもFranz社は、Lispをビジネスとして成立させることに興味があって頼もしい。Fritzは2日目のパネルディスカッションで、Franz社が最後のLisp企業だと強く自覚しているように見えたけど、それにはすべての聴衆が素朴に好感を持ったと思う。Semantic! Semantic! っていっても、それはやっぱりビジネスマンとしての売り文句で、純粋に美しいテクノロジーが好きなんだろうなあ。

以下はどうでもいい話。

やっぱり懇親会ではSchemerの肩身が狭い。自分のようなTiny Schemerだとなおさら。でも楽しいのはなんでだろう。

いいかげんな英語でもいいから、話をしないとダメだ。

CLOSを勉強しないとダメだ。小出先生の発表で、「CLOS/MOPがメタ-メタ-…-オブジェクトを云々するのはラッセルのパラドクスにつながるから論理屋には絶対に理解できない」みたいな軽口があったけど、あれはどういう話だったんだろう？　それって単純に巨大基数に対応してるんと違う？

『Binary Hacks』のサンプルPDFでは川合史朗さんによる巻頭言が読めて、プロのプログラマにとって抽象化の壁に無自覚でいるのは致命的だ、と主張されている。もちろんこれはBinary Hacksの巻頭言なので、抽象化が下に有界であることを忘れないようにしないといけないよ、という警鐘と受け止めていいんだと思う。ぶっちゃけていえば、土台を固めろ。もしくは、土台を意識できるようになれ。

その手の抽象化の漏れを自覚することの大切さっていうのは、誰かが抽象化したものを使うときの落し穴を自覚することの大切さだといえる。川合さんの文章にある「箱庭の製作者のアイディアを抜ける」ことは、いわば誰かが手がけた抽象化の漏れを自分でふさぐことを指しているんだろう（勝手な解釈だけど）。

一方で現実の問題を解くうえでは、誰かが抽象化したものをてなずけるだけでなく、自分自身で何かしら抽象化っぽいことをしたい。そのときに求められる自覚は、当たり前だけど、『Binary Hacks』の巻頭言で示唆されている自覚とは別ものだ。もちろん、よりエグいレベルからの抽象化を自分でするなら、まさにBinary Hacksが必要になるんだろう。ただし、たとえばぼくにとっては『Binary Hacks』で扱っているような題材はとうてい自分の力だけでゼロから抽象化できるしろものじゃない。

もっとかわいらしい抽象化のためのHacksも欲しい。「箱庭の箱庭の箱庭を別の屋敷の箱庭にコピーして、さらにその中に自分で箱庭を作るときに抽象化を漏らしにくくするHacks」みたいなの。ちゃちな問題であっても抽象化っていうのはやっぱり強力なので、その無自覚に享受しがちなパワーに目がくらんで掘りがちな落とし穴は何か。そもそも落とし穴を作らないためのHacksは？

たぶん、それは数学なんだと思う。ふだん僕らは、直観的に確からしいと思ってあるアイデアをコーディングし、期待する答えが得られた時点で問題を解いたものとみなしている。問題を解くアプローチや道具を手に入れたところで満足しちゃっている。そのアプローチや道具が本当に適切なのかどうかを確かめるには数学しかない。

ありがちな例はハノイの塔だろう。ハノイの塔の解法を説明した記事は、数学っぽいおはなしでもよく目にする。「一番下の1枚だけ残して隣の棒に移動し、一番下の1枚をあまっている棒に移動して、移動しておいた残りをその上に移動しなきゃいけない」という説明。そんなふうな説明から「n 枚のディスクを移動するのにかかる工数を H(n) とすると、 H(n) = H(n-1) + 1 + H(n-1) 」という関係を導いてくる。1枚ずつディスクを移動するって操作を抽象化して考えることで問題の構造が見えてくるよね、みたいな。でもそれだけだと、どんなに工数がかかったとしてもそれくらいには抑えられるってことしかわかりませんから。もっと少ない方法があるかもしれない。

もちろん実際にはない。ただし、それは数学的帰納法で証明して、はじめて「ない」と断言できる。そして道具や解法の抽象化は、どこまでいっても具体的な事物が対象だからではなく、たぶんこういうところからのほうが漏れやすい。たぶん。

こういう抽象化を漏らさないための数学について、楽しい教科書がないものかなあと思う。ちょうど、深いところに抽象化された部分について『Binary Hacks』が果たすであろう役割に相当するような本が。数学の楽しいところや神秘的に見えちゃうところを取り上げて『Math Hacks』とかっていう方向もあるだろうけど、それは答えじゃないと思っている。むしろ、普通の数学と同等の内容を持つ教科書をプログラマ向けに企画することが直接の答えのひとつだと思っていたし、いまでも思っている。

あるいは、ここ1〜2年くらいだけど、 "SICP" や "Concrete Mathematics" こそがそういう本に違いないという確信も持つようになった（上のハノイの塔の落とし穴も"Concrete Mathematics"の冒頭で取り上げられている例がそのまんま）。つまり、抽象化することのパワーを解説や練習問題をとおして読者に伝えるような本で、しかも直観だけでなく数学的に証明可能な抽象化の道を示しているような本（証明が書き下されている必要はない。分かっていて省略するのと結果的に省略されちゃってるのは別）。しかも、"SICP" や "Concrete Mathematics" よりもっとミニマルな内容におさえたとっつきやすい本にできるはず。←いまこのへん

まあ、本があるだけじゃだめで、手を動かして訓練しないスキルは決して身につかないんですがね。数学に限らず。

部分から全体を推測することが統計の本質というより、全体がいい具合に推測できるように適切な部分を取り出したいというのが統計の本質なんだと思っていた。その際、全体については「何らかの確率分布にしたがう」という仮定を設定するので、その仮定が妥当である限り、おれカネゴンさんのような心配は不要なはず。もちろん、これは統計というものの全体についていえる話ではなくて、統計的推測といわれているものについての話です。

なんかよく分からないけど取ってきちゃった部分から全体を推測しようとする統計もある。その傾向が強くなるほど、数学とは離れたものになっていくような気がする。そういう需要もあるのでそういう分野もあり、やはり統計と名乗っているので、統計の教科書にのっているから数学により正しいことが保障されるといった妄想は妄想です。全体の傾向を分析するひとつの手段としてはありえると思うので批判したりするつもりはありません。

なんか、ちっとも確からしさのない脊髄反射的な文章になってしまい申し訳ありません。

0.999...は1かっていうのは、ゆっくり慎重に考えれば解けるクイズのような問題ではないし、定義でもないと思う。もちろん哲学でもない。とはいえ、哲学っていうのがいちばんしっくりくる表現なのかもしれないやね。「哲学が何か」なんて知る由もありませんが、雰囲気として。だって、ようするにそれを納得するかどうかだけがポイントだと思うから。定義なんだから納得しろっていう話じゃないよ。それなりに数学を勉強して経験していくと、そのうち、そう考えざるを得なくなるってこと。

虚数の概念とかもそう。虚（imaginary）という字面や、一方で「実」数という概念があったりするから混乱を引き起こしやすいと思うんだけど、別に虚数は空想上のモノでもなんでもない。虚数のimaginaryっぷりは、実数のimaginaryといい勝負だと思う。逆に言うと（逆だよね）、実数とかいっても名前ほどにはrealじゃなくて、たとえばπの実在っぷりを2次元アイドルの実在っぷり以上に強烈に感じられる人はすごいと思う。もういっかい逆に言うと、いろいろな場面で必然的に虚数が現れるのを目の当たりにすれば、そのうち必要に応じた虚数のrealさを納得できるようになるのではあるまいかと。

確かに、いつまでたっても納得できない人はいる。でもそれって、頭の良し悪しとかじゃなくって、単に納得したくないだけなんじゃないだろうか。あとは、訓練が足りないか。ある概念について納得するっていうのは、その概念を提示している記号の字面と日常的な正しさの感覚だけで到達できるような態度じゃないから、ある程度の努力とか歩み寄りは必要だと思う。

校正待ちですることがないので（後半はうそ）、Code Golf の "Switchboard" という問題に手をつけてみた。コードを短くすることはともかく、この問題は解法を考えるのが面白かった。いまのところ23位だけど、これが個人的なスキルの限界だと思う。

Scheme は受け付けてない。そうとはしらず最初は暢気に Scheme で書いたことはいうまでもない。しょうがないので Ruby で書き直したんだけど、"gets" だけで標準入力から1行読み取れるなんて。実用的にもほどがある。

おいしいとんかつの店は三河島の「山き（きは「七」を森のように重ねた字）」だよ！ このへん
どうもあんまり知られてないようなので、叫んでおく。

ヒレがびっくり。とんかつといえばロースだと信じてたのに、その常識を覆された。あと、メンチ。ヒレもメンチもそれまでどっちかっていうとバカにしていた料理だったけど、本当にごめんなさい。もちろんロースもうまい。
ただ、メニューが少ないし、キャベツに対する選択肢がソースしかないので、軟弱な人にはおすすめしない。地元ゆえのひいき目っていうのもある。それでも、普通の豚を普通のとんかつとして硬派に堪能したいなら、絶対におすすめ。普通なのに、軽くびっくりするんだよね。外食にはびっくりが必要だと思う。しみじみうまいだけなら家で食うさ。

店内の色紙によると、阿佐谷の「かつ源」という店からのれんわけしたようだ。あんまり知られてなくて、いつも暇そうにしているので、ちょと応援したい。

SICP の ex. 4.11〜4.13 をうろうろしていたら、ようやく set-car! や set-cdr!が set! と根本的に違うことが飲み込めてきた。いままでそんなこともきちんと知らなかったのかよ。

たとえば次の2つの例は、いっけんすると同じ結果になる。つまり a に (0 1 2 3) が束縛された状態になる。

(define a '(1 2 3))
(let ((current-a (list-copy a)))
  (set-car! a 0)
  (set-cdr! a current-a))

gosh>a
(0 1 2 3)

(define a '(1 2 3))
(set! a (cons 0 a))

gosh>a
(0 1 2 3)

set-car! と set-cdr! の場合には、もともと a が指し示す領域にあったデータが書き換わっている。それに対して set! でやっていることは、もともと a が指し示す領域にあったデータは換わってなくて、a という名前で束縛されていたものを別の場所に cons して作った (0 1 2 3) に 付け換えたにすぎない。

で、この違いを理解していないことが ex. 4.11 付近で評価器が扱う環境の定義をしたりするときにネックになるわけで、define したつもりのものが環境に登録されずに悩むことになったりするのは僕だけか……。ところで「Schemeは十分に抽象的だけどビットが透けて見えることがある」みたいなことを言ったのは誰だっけ？

この話のとってつけたような結論はお好みに合わせて随時読みかえることができます。

• やっぱりローレベルの知識が足りないやつは帰れってことだよね。そういえばJoelさんもそんなようなことを言ってたなあ。
• やっぱり参照透過じゃないとだめだよね。びっくりマーク？なにそれ。

---

どうでもいいけど、僕は、こういう基本的なことを知らなかったという「恥」を恥と承知して公にさらすことには旨味があると思っている。これは、「知らないなりに考えてみたけど間違ってたら誰か教えてね」という意味ではない。なんか、そういう恥2.0みたいなノリじゃない。恥2.0ではブログツールのコメントとかトラックバックとかはてな何とかとか巨大掲示板といったAPIによりあなたの恥を知識と経験に昇華してあわよくばWebコミュニティへのネタを提供します。よかったね。あるいは、「自分は知らないことを知らないまま放置しない向上心と努力あふれる人間であります」というアピールになるという意味でもない。そういう態度がアピールにはなるのは、ぶっちゃけ小学校の教師に対してだけだろう。努力だけはしてるように見える人と、どこで勉強してるかわかんないけどアウトプットをきちんと出している人がいたら、自分は後者と仕事することを選ぶ。

「聞くは一瞬の恥」とかいうけど、僕には、それで教えてもらった内容だけを自分のなかに保存することができない。恥体験と一緒だから内容が見に付くという側面があるように思う。この側面は、自分自身に固有の経験だけから傍証しているものなので、ほかの人にも当てはまるのかどうかは知らない。まあ、恥も外聞もなく分からないことを聞きまくっている人間にろくなスキルを見に付けていない（ように見える）のが多いとは思うけど。

ようするに独学でスキルを得るには恥の追体験が必要ってことだ。将来の自分は、今日書いた内容を恥ずかしく思い返す必要がある。紙の大学ノートに同じことを書いてもいいんだけど、それは「恥」じゃないんだよね。将来の自分は、今日書いた内容を公開したことを恥ずかしく思い返す必要がある。このノートは恥のタイムシフト装置です。

temp

emacs から blogger に投稿したい。

Atom Publishing Protocol というのがあって、それをemacs から使えるようにする atom-blogger.el というのがあった。設定方法はここに丁寧に解説されている。

Using atom-blogger with emacs to post to blogger
http://phototechnic.blogspot.com/2006/03/using-atom-blogger-with-emacs-to-post.html

emacs への設定だけをしても、captcha が邪魔するらしく、まったく投稿できない。captcha をオフにする方法もよくわからない。さんざんあちこちクリックして、投稿時のcaptcha の横にある「？」マークをクリックすれば captcha を解除するメニューに入れることが気づいた。なにそれ。

で、そのメニューいわく、「Bloggerのスパム対策ロボットにより、このブログにスパム ブログの疑いがあることが検出されました」。

どうやら captcha による投稿時の認証は、ユーザが望んでオンになるものではなく、bloggerの運営者が「スパムブログ」と判断したものに勝手に設定しているらしい。さっきまでこのノートは Link Spam（Wikipedia）に使われてたらしいよ。Wikipedia によると "Search engine spammers, on the other hand, are generally aware that the content that they promote is not very useful or relevant to the ordinary internet surfer."

ぐうのねもでませんって。

ツインピークスで、クーパー捜査官がこうつぶやくシーンがある（wikiquote）。

Every day, once a day, give yourself a present.
Don't plan it, don't wait for it, just… let it happen.

毎日ひとつ、自分にプレゼントを。
用意したり待ち望んだりするプレゼントじゃなくって、なにげないやつでいい。

クーパーはこのセリフを、確か一杯のコーヒーについて言っていた気がする。恋人のアニーが一緒だったような気もする。いかんせんセカンドシーズンのDVDがいつまでたってもリリースされないので、そんなようなシーンを記憶の中で作り上げていただけかもしれない。どうでもいいけど、アニーとクーパーはショーペンハウアーのネタで盛り上げれるキチガイだ。

そんなわけで、コーヒーを楽しく飲むと、もう一日の楽しみが潰えたような心地になる。

同じグループの同僚が鼻歌まじりで仕事してたりすると、不思議に自分も仕事に集中できるもんなんだな。集中しようという意識が持て、しかもそれに成功する。一緒に仕事している人間が上機嫌だってことは、彼女の仕事もうまく動いてるってことだ。そんなプラスの気配がいつも充満している職場ならパーティションはかえって邪魔だろう。たぶんバランスボールのある職場にいる人達はそれを知ってる。

生産性のことさらに低い同僚が鼻歌まじりだったりすればイライラが募る。だから、生産性の低い人間を雇い続けなければいけない職場ではパーティションが必要なんだろう。パーティションより必要なものがあるような気がするので、パーティションを作ってくれとはいわない。せめて本棚をください。

名前付きletをlambda式にしたい。

SICPの第4章では、Schemeの式の評価機をSchemeで書く。こう書くとやたらに抽象的で深遠でカッコよさげに聞こえるけど、まずはプロシージャをいくつかのスペシャルフォームによる表現に均さないといけないからandやorをletをlambdaにするとか、そういうどちらかというとバタ臭い作業が続く。
で、ex.4.8では、名前付きletをlambda式にしろとある。letrecがないので、たぶん正解はinternal defineを使う方法。でも、そろそろ式の表現を変換するだけの作業には飽きてきたので、不必要に解答をややこしくしてみる。つまり、要するに関数を再帰させる話だと解釈して、こういう問題設定にする。

再帰的なプロシージャを抽象化したい。

答えは分かっている。Yコンビネータだ。というわけで、以下はYコンビネータのおさらい。"The Little Schemer"の第9章の翻案ともいう。

まず、再帰を含む関数を用意する。たとえばex. 4.8のフィボナッチ名前付きlet版。

(define (fib n)
  (let fib-iter ((a 1) (b 0) (count n))
    (if (= count 0)
        b
        (fib-iter (+ a b) a (- count 1)))))

count≠0 のときに再帰しているので、 count > 0 のときに適当に答えを出してくれる fib-iter-1 というプロシージャが世界のどこかでよろしく定義されていると妄想する。

(define (fib n)
  ((lambda (a b count) 
      (if (= count 0)
          b
          (fib-iter-1 (+ a b) a (- count 1))))
   1 0 n))

再帰しないですむようになったので、もうletに名前はいらない。それで、ついでにletをlambda式にしておいた。もちろん、実際には fib-iter-1 なんていう都合のいいプロシージャはないし、もしあっても fib-iter-1 の中にはきっと再帰があるだろう。fib-iter-1 の再帰を片付けるのに fib-iter-2 を妄想し、さらに fib-iter-2 の再帰を片付けるのに fib-iter-3 を妄想し、……嘘をつき続けなければならない。

そこで発想を飛ばして、「fib-iter-1を妄想する」ことを抽象化してみよう。ちょっと分かりにくいけど、妄想したいものを受け取ってfibの中身のlambdaを返してくれるようなプロシージャを作ればいい。つまりこんな感じ。

(lambda (fib-iter)
  (lambda (a b count) 
    (if (= count 0)
        b
        (fib-iter (+ a b) a (- count 1)))))

ただし現実には「妄想の果て」が必要になる。また妄想なんだけど、とりあえず果てに行き付いたので無理矢理納得することにする。妄想の果てを fib-iter-omega とすると、

(define (fib n)
  (((lambda (fib-iter)
      (lambda (a b count) 
        (if (= count 0)
            b
            (fib-iter (+ a b) a (- count 1)))))
    fib-iter-omega)
   1 0 n))

ここで再び発想を飛ばして、今度は「妄想の果て」を抽象化する。それには、妄想を受け取って妄想を返し続けるようなプロシージャを作ればいい。こんな禅問答のようなプロシージャが考えられる。

(lambda (fib-iter) (fib-iter fib-iter))

これってつまり「関数を自分にぶちこむ」ってことなので、「再帰する」ことを抽象化しているとも考えられる。

ところが、実はこれだけだと果てしなく続く妄想だけになっちゃて、妄想の仕様が何も分からない。仕様がないものは使いようがない。そこで、まずは妄想を整形してやって、それを「果てしなく続く妄想」に渡すようにしてやりたい。いま考えているfib-iterでは3つの引数（a,b,const）を使っているので、この「妄想の果て」も3つの引数をとるプロシージャを返すようにしないといけない。

(lambda (delusion)
  ((lambda (fib-iter) (fib-iter fib-iter))
   (lambda (f) (delusion (lambda (x y z) ((f f) x y z))))))

妄想delusionを受け取って、それを3引数を取るプロシージャの形にして、後はひたすら妄想を続けるというノリ。これがYコンビネータ。だからYコンビネータは、妄想を使えるものにするための、どっちかっていうとテクニカルな細工なんだと思う。

以上をfibに取り込むと、こうなる。

(define (fib n)
  (((lambda (delusion)
      ((lambda (fib-iter) (fib-iter fib-iter))
       (lambda (f) (delusion (lambda (x y z) ((f f) x y z))))))
    (lambda (fib-iter)
      (lambda (a b count)
        (if (= count 0)
            b
            (fib-iter (+ a b) a (- count 1))))))
   1 0 n))

もうすっかり妄想が抽象化されつくしたので、これはフィボナッチ数列のn項を求めるプロシージャとしてちゃんと評価される。

gosh> (map fib (iota 20))
(0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181)

御徒町の工具屋さんにPBの六角レンチを1本買いにいったつもりが、お店の人にそそのかされてStahlwille（スタビレー）のコンビネーションレンチを5本買ってしまった。まともなスパナをもってなかったので、ちょうどいい機会だったと思うことにしよう。っていうかほしかったんです。



スタビレーはドイツの老舗工具メーカーで、Snap-onみたいなテカテカのアメリカ工具がもてはやされる昨今ではむしろ珍しくなってしまった梨地仕上げの表面加工で有名（やっぱ工具はドイツだよなあ。ちなみにPBもドイツはスイスだった）。購入したのは、今年から製造中止になってしまったOpen-Box Type 15というコンビネーションレンチの10mm, 12mm, 13mm, 14mm, 17mm。

Stahlwilleのプレーンなコンビネーションレンチには、大きく分けるとType 13とType 14というのがあって、全長がちがう。Type 14のほうが長い。Type 15は、長いほうのType 14と同じ全長で、オープンエンドの形状が違う。Type 15のオープンエンドは側面が凸曲線に加工されていて、StahlwilleではSoftGRIPと呼んでいた。奥の形状も六角形のボルトヘッドに近いものになっている。写真左がType 15で、右はずいぶん昔にホームセンターで買った安物。



一般にオープンエンドのレンチでボルトに強い力をかけると、6面あるうちの2面（もっというと、その2面の片方の対角線のエンド2点だけ）しか接触しないので、ボルトヘッドをなめやすい。そのためコンビネーションレンチは、オープンエンド側で仮締めや早回しをしてメガネ側で強い力をかけるのが正しい使い方。とはいえ、とくにアマチュアだと、オープンエンド側でもそれなりに力をいれたい場合がある。というわけで、Type 15のようなオープンエンドがうれしい。それに側面が凸になっているってことは、口が開いてるってことでもあるわけで、早回しの際にボルトヘッドにひっかけやすいのもうれしい。どこかの通販サイトによると、"The sculptured jaw provides an extra grip on screws and nuts with 25% more static load capacity and 40% more permanent load capacity than standard wrenches. "だって。（残念ながら公式の情報は見つからなかった。）

ところがType 14よりちょっぴり定価が高かったせいか、ドイツでは流行らなかったらしい（お店の人談）。まあ、ドイツの職人はアマチュアにうれしいツールをわざわざ高い値段で買わないってことなのかもしれない。そんなわけで、すでに入手できるのは現在流通しているもののみ。ただ、今のところ在庫処分扱いなので、どうやら安売りしてるっぽい。スタビレーのレンチ5本が9000円以下ってだけで、かなりお買い得。

GaucheにもRubyみたいなARGFがほしい。
正確にいうと、ほしがっているのは僕じゃないんだけど、確かにARGFみたいな仕組みがあると使い捨てのテキストフィルタを書いたりするのは簡単になりそうだ。Gaucheのマニュアルではmainを使うことが推奨されているけど、気楽で泥臭いスクリプトを作りたいことだってある。

RubyのリファレンスマニュアルのARGFの項目には「スクリプトに指定した引数 (ARGV を参照) をファイル名とみなして、それらのファイルを連結した 1 つの仮想ファイルを表すオブジェクト」とある。その説明がARGFのすべてなら、Gaucheに用意されている仮想ポートで似たようなものが作れるかもしれない。

でっちあげてみた。引数として渡されたファイルのテキストをいったんバッファに吐き出しているので、Rubyのように*argv*のリストが変更されるわけではない。バッファが空なら標準入力を読む。

#! /usr/local/bin/gosh

(use gauche.vport)
(use srfi-13)

(define argv-str
  (let R ((files *argv*) (str ""))
    (if (null? files)
        ""
        (call-with-input-file (car files)
          (lambda (port)
            (let ((joined-string
                   (string-join (list str (port->string port)) "" 'strict-infix)))
            (if (not (null? (cdr files)))
                (R (cdr files) joined-string)
                joined-string)))))))

(define (getc str)
  (cond ((> (string-length str) 0)
         (let ((c (string-ref str 0)))
           (set! argv-str (string-drop str 1))
           c))
        ((= (string-length str) 0)
         "")
        (else
         (error "Out of Range -- getc"))))

(define (argf thunk)
  (if (string-null? argv-str)
      (with-input-from-port (current-input-port)
        thunk)
      (with-input-from-port
          (make <virtual-input-port>
            :getc (lambda () (getc argv-str)))
        thunk)))

;;; test
(argf (lambda () 
        (port-for-each 
          (lambda (line) (print (regexp-replace #/hello/ line "damn")))
        read-line)))

実行結果

$ cat test.txt
hello world
this is argf test
$ ./argf.scm test.txt test.txt
damn world
this is argf test
damn world
this is argf test
$ cat test.txt test.txt | ./argf.scm
damn world
this is argf test
damn world
this is argf test

作ってから必ず思う、すでにこんなのは誰かが作っているんではないだろうか。

荒れまくっていたウィキペディアの実数の項目が素敵な解説に直されて先週復活していた。編集履歴を見ると、Makotoyさんという方の尽力らしい。

荒れる原因になったもとの解説は数直線を使ったもので、「実数は有理数を項とする無限数列の収束値として得られる」と説明していたようだ。で、そこからなぜか無限小数の表現が0をのぞいて一意に決まるとか決まらないとかの議論になって、それで紛糾していたらしい。なにか世界には「実数」という確固たるモノがあるって素朴に思いがちだけど、実際には順序と演算を適切に用意してやることで公理的に決まるだけのものにすぎない。つまり、数字を使わなくても構築できて、でもそれは結局は数字で表現するふつうの実数と同型になる。そんなわけで、数字とか数直線上の点をもって実数とは何かを議論するのは、あんまり意味がないと思うんだけど、どうして1.0000……とか0.9999……とか、数字に異常に固執する人がいるんだろう。きっとあれだ。小学校の教師が悪いんだ。

行列の固有値を求めたい。
なにをいまさら感たっぷりなんだけど、理系の出版社でテクニカルレビューっぽいことをしていると、特に統計の本なんかで行列の固有値を検算したい場合がなきにしもあらず。たいていは Maxima に突っ込んじゃえばいいんだけど、Maxima では特性多項式を作ってそれを解いているらしく、うまく解が求まりやがらないことがある。実際、maxima/share/matrix/eigen.macを見ると、charpolyという関数で特定多項式を作り、それをsolveという関数で解いている。で、この solve という多項式を解く関数がうまくないといったことがMaximaのマニュアルにも書いてある。

eigenvalues calls the function solve to find the roots of the characteristic polynomial of the matrix. Sometimes solve may not be able to find the roots of the polynomial

幸い、固有値を求めたい行列は対称行列ばっかりなので、自分でJacobi法をナイーブに実装してみた。対称行列だとうれしい理由やJacobi法については『プログラミングのための線形代数』の第5章で。

jacobi.scm

gosh> 
(define A
  ((make-matrix 6 6)
   0.68 0.65 0.8 0.11 0.01 0.14 0.65 0.88 0.89 0.02 0.19 0.01 0.8 0.89 0.91 0.02 0.04 0.1 0.11
   0.02 0.02 0.81 0.82 0.77 0.01 0.19 0.04 0.82 0.81 0.64 0.14 0.01 0.1 0.77 0.64 0.66))

gosh> A
((0.68 0.65 0.8 0.11 0.01 0.14) (0.65 0.88 0.89 0.02 0.19 0.01) (0.8 0.89 0.91 0.02 0.04 0.1) 
(0.11 0.02 0.02 0.81 0.82 0.77) (0.01 0.19 0.04 0.82 0.81 0.64) (0.14 0.01 0.1 0.77 0.64 0.66))

gosh> (eigenvalues-jacobi A)
(-0.010575430595377565 -0.09400171282374802 2.109504119397093 -0.08138275206455295 0.279213041557744 2.5472427345288424)

行列のデータをどういうふうに表現すべきなのか、ひどく悩んだ。Dybvig 本のようにベクトルを使うのがセオリーなんだろう。ベクトルなら行列のij要素を取り出したり変更したりするのも簡単だ。でも、行と列を順繰りになめて各要素をちこちこ掛けたり足したりする処理ばっかり書くことになりそうで、ちょとブルー。そんなわけで今回はあえてリストのリストとして定義した（行ベクトルが1つのリスト。それを要素に持つ縦ベクトルのリストが行列）。リストなので、行列の積や和なんかも高階関数だけで定義できる。

(define (matrix-transform m)
  (apply zip m))
(define (matrix-product m1 m2)
  (if (not (= (line-length m1) (row-length m2)))
      (error "Matrix-Product Not Defined" (list m1 m2))
      (apply (make-matrix (line-length m1) (row-length m2))
             (map (cut fold + 0 <>)
                  (map (cut apply map * <>)
                       (cartesian-product (list m1 (matrix-transform m2))))))))
(define (matrix-sum m1 . ms)
  (map (cut apply map + <>)
       (apply zip m1 ms)))

ちょっと満足。ただし単位行列や回転行列を定義するのに要素を頭からなめるはめになってるんだけどね。満足しちゃだめ！

ときどきむしょうにハンダ付けがしたくなる。ちょうど先週、妙に面白いキットばかり開発して秋月で販売しているトライステートからSHOUTcast形式のインターネットラジオを再生するBBシャウトというキットが発売されたので、これを作ってみた。お値段はちょっぴり張りますが。

SHOUTcastはWinAmpで有名なNullsoftが開発したストリーミング技術で、MP3などのメディアをHTTPの拡張を使ってサーバからマルチキャストするものらしい。受信と再生はWinAmpだけでなくiTunesなどでもできる。ただ、どうやら日本にはあまりサーバがない。現に、Wikipediaには「ストリームの生成にはSHOUTcastのサービスを使うのが現実的な選択」とあるのに、ウィキペディアを見ると「インターネット放送の集合体」という適当な扱いを強いられている。まあ、ジャズとクラシックを無作為に流しっぱなしにするだけなら困ることはない。ところで店舗でBGMに海外のSHOUTcastを流してても、やっぱりJASRACから破廉恥な請求を受ける危険があるのかしら。

で、このSHOUTcast形式で配信されているストリームを受信して再生する専用のボードがBBシャウト。キットは、僕のような素人でも2時間くらいで完成します。いわゆるブロードバンドルータにつないで電源とスピーカーを接続すれば、プリセットされている放送局の音源はすぐに聴ける。



やっぱり箱に入れないと不便だな。

個人的な理由で2日間会社を休んでいる間に Debian サーバがアップデートされていた。ありがとうございます && ごくろうさまです ＞ hさん。ところでなんか amazon から不思議な商品が届いたんですが、これを何に使えと？

で、アップデートの結果、telnet でログインできなくなっていた。まあ、telnetd を動かさないこと自体はまったくOKっす。ただ、今まで TeraTerm から SSH2 でログインする気になれなかったので、サーバ上には公開鍵がないんです。公開鍵を登録しようにもサーバにログインできないんです。
幸い samba が利用できるようだったので、エクスプローラ上で公開鍵をコピーして ~/.ssh/authorized_keys を作った。これでつながるよね。
ところが TeraTerm（SSH2,utf-8対応版）でまったくつながらない。Cygwin からもだめ。TeraTerm のダイアログに表示されるエラーメッセージは意味不明だし、Cygwin から ssh コマンドで接続を試みても "Permission denied (publickey)."といわれるばかりだし。

結局『OpenSSHセキュリティ管理ガイド』の267ページを見てようやく解決した。~/ssh/authorized_keys のパーミッションが user 以外に書き込み可能になってたりすると、この "Permission denied (publickey)." というエラーが出るらしい（ただし、StrictModes が no ならエラーにならない）。今回のケースだと samba から authorized_keys を作ったので、そのパーミッションは 666 になっていた。しょうがないので、あきらめてコンソールからログインしてパーミッションを設定しなおす。

教訓

* 最初からコンソールに移動して作業しろ
* エラーメッセージは google する前に本で調べろ

会社を休んで日本ソフトウエア科学会のPPLサマースクールを受講してきた。へとへとになって日暮里まで帰ってきて、考え事をしながら歩いてたら、道に迷った。もう天才的な方向音痴のCさんを馬鹿にできない。っていうか、最近Cさんにセクハラで訴えられかねないくらいつらくあたりすぎ。本当に反省しています。ごめんなさい。

第４回プログラミングおよびプログラミング言語サマースクール
http://www.math.nagoya-u.ac.jp/~garrigue/ppl_ss06/

---

圏論の諸相（講師：木下佳樹先生）

冒頭で「諸相といっても2時間で話せるのはせいぜい1相」という前フリがあったけど、本当にそうだった。そんなわけで、Haskell→圏論というノリの参加者にはつまらなかったかもしれない。
個人的には、これまで聞きかじっている知識に横糸を何本か通すことができてよかった。以下、講義中に勝手に頭の中で構成したまとめ。絶対に参考にしてほしくないわけですが（どうせこんなページに圏論について真剣に知りたい人はこない）、詳しい人に勘違いを指摘していただくのは大歓迎です。

圏論ってのは、「集合全体の集合」とか「写像全体の写像」のように、集合論だけだとパラドクスを誘発しかねない何かを扱うべく捻り出された概念なんだよね。たしか。だから、「集合全体の集合」みたいなものにやばさを感じない限り、そもそも圏論のありがたみとか面白さはわからないような気がする。講義で「"small"な集合」という言い方を強調してたり、「集合の要素を使わずに単射の定義を与えてみよう」というクイズで「集合全体の集合を認める」という但し書きをしていたのには、そういう事情があるはず。
で、この「集合の要素を使わずに単射の定義を与えてみよう」クイズがえらく自分のツボに入った。集合AからBへの単射っていうのは、ぶっちゃけると集合Aの要素と集合Bの要素が1対1に対応しますってことで、それを「要素」とか言わないで定義しろっていうのがクイズの趣旨。答えはこうなる。

f が集合 A から集合 B への単射
=def 
任意の集合C と任意の h,k:C→A について f・h = f・k ⇒ h = k

つまり、単射という写す集合と写される集合の要素に関する問題を、移すほうに値域を持つ別な任意の写像（ただし定義域は固定）どおしの関係として定義すればいいってこと（ちなみに講義では、たぶんあえて、定義域とか値域うんぬんの議論をぼかしてた。当たり前っちゃ当たり前のことなんだけど、これが固定されていないと f との合成写像を取ったところで何の意味もない。そのため圏論では、定義域と値域をあわせて写像ではなく「射」という言葉を使ってる。たぶん。僕のこれまでの圏論の認識といえば「射で考えるやり方」という程度だったので、今日の講義でようやくさっぱりした）。
同じように任意の集合とそこからの任意の射を使うことで、単射に限らず数々の集合っぽい概念を再定義できる。ところで、たとえば直積がペアをあらわすように、集合の概念はデータ構造を形成できる。ってことは、圏でもやっぱりデータ構造を定式化できるよね。たぶん、これが今日の講義のメインだったんだと思う。

---

２時間で真似(まね)ぶ関数型言語のコンパイラ（講師：住井英二郎先生）

MinCamlの話は仕事や趣味からはいちばん近い話題で予備知識も多かったせいか、関心するところが多すぎてあまり扇動的な気分にはなれず……。実はこのサマースクールに参加した背景には、講義の内容から技術的な知見を得たいっていう以上に、精神的にアジテートされたいっていう動機があった。まあ、お前の求めてるものがおかしいって話なんですが。
余裕があったらまとめをかく。

---

述語抽象化によるアルゴリズムの検証 ～ シェープ解析を例として（講師：田辺良則先生）

プログラムの安全性を検証したいけどすべての状態と状態遷移を検証するのは無理だよね、それなら数学的に証明された方法で抽象化した状態とその遷移をうまく取り出して検証しましょうって話。まったく予備知識のない分野だったせいか、3時限目にもかかわらず異常に興奮した。プレゼンも面白い。
これも、余裕があったらまとめをかく。

いよいよネタ切れか。とりあえず内部でプロシージャを定義するのを止めて、ついでに末尾再帰にだけしておこう。

(define (quicksort/values/cps ls k)
  (if (null? ls)
      (k '())
      (quicksort/values/cps
       (cdr ls)
       (lambda (cdrls)
         (receive (low high)
                  (partition (cut > (car ls) <>) (k cdrls))
                  (append low
                          (cons (car ls) high)))))))

昨日で一気にFPっぷりがあがった気がする。にしてもダサい名前のつけ方だ。

急がないと歯医者に間に合わないけど、ひきつづきクイックソート。partitionかあ。ありがとうございます＞nobsun

(define (quicksort/values ls)
  (define (low-high ls)
    (partition
     (cut > (car ls) <>)
     (cdr ls)))
  (if (null? ls)
      '()
      (receive (low high)
               (low-high ls)
               (append (quicksort/values low)
                       (cons (car ls) (quicksort/values high))))))

気が付くと lambda がいない。

Scheme Kata の続き。いちおう毎日ちょっとでも続けたいんだけど正直ネタ切れ。なんで初日に4つも作っちゃったんだろう……。
苦し紛れに昨日の多値を使ったバージョンをそのままreceiveを使って書き直す。hanataniさんに教えてもらうまでreceiveもcutも知らなかったから、苦し紛れとはいえ個人的な訓練にはなっているような気がする。Kata だからそれでいいじゃん。

(define (quicksort/values ls)
  (define (low-x-high)
    (values
     (filter (cut > (car ls) <>) (cdr ls))
     (list (car ls))
     (filter (cut <= (car ls) <>) (cdr ls))))
  (if (null? ls)
      '()
      (receive (low x high)
               (low-x-high)
               (append (quicksort/values low)
                       x
                       (quicksort/values high)))))

Scheme Kata のつづき。多値でクイックソート。filter からは逃れられず。

(define (quicksort/values ls)
  (if (null? ls)
      '()
      (call-with-values
          (lambda ()
            (values
             (filter (lambda (x) (> (car ls) x)) (cdr ls))
             (list (car ls))
             (filter (lambda (x) (<= (car ls) x)) (cdr ls))))
        (lambda (low x high)
          (append (quicksort/values low)
                  x
                  (quicksort/values high))))))

いまさら Code Kata をやってみようと思った。といっても Kata 1 はコードを書くわけじゃないのか。というわけで Kata 2 から。うーん、二分木の探索ねえ。めんどくさいので勝手にクイックソートに問題を変更させていだきます。でも4つしか思いつきません。しかも二個目は一個目からコピペしただけのいんちき。ほかにどんな方法があるんだろう。

(use srfi-1)
(define ls '(4 9 2 5 8 7 3 1 6 4))

(define (quicksort1 ls)
  (if (null? ls)
      '()
      (append (filter (lambda (x) (> (car ls) x)) (quicksort1 (cdr ls)))
              (list (car ls))
              (filter (lambda (x) (<= (car ls) x)) (quicksort1 (cdr ls))))))
(quicksort1 ls)

(define (quicksort2 ls)
  (call/cc
   (lambda (k)
     (if (null? ls)
         k
         (append (filter (lambda (x) (> (car ls) x)) (quicksort2 (cdr ls)))
                 (list (car ls))
                 (filter (lambda (x) (<= (car ls) x)) (quicksort2 (cdr ls))))))))
(quicksort2 ls)

(define (quicksort/cps1 ls k)
  (if (null? ls)
      (k '())
      (quicksort/cps1
       (cdr ls)
       (lambda (cdrls)
         (append (filter (lambda (x) (> (car ls) x)) (k cdrls))
                 (list (car ls))
                 (filter (lambda (x) (<= (car ls) x)) (k cdrls)))))))
(quicksort/cps1 ls (lambda (k) k))

(define (quicksort/cps2 ls k)
  (if (null? ls)
      (k '())
      (quicksort/cps2
       (filter (lambda (x) (> (car ls) x)) (cdr ls))
       (lambda (ls-lower)
         (quicksort/cps2 (filter (lambda (x) (<= (car ls) x)) (cdr ls))
                         (lambda (ls-upper) 
                           (k (append ls-lower 
                                      (list (car ls))
                                      ls-upper))))))))
(quicksort/cps2 ls (lambda (k) k))

Code Kata というより Scheme Kata？
どれも基本となる部分は filter で、芸がなくって本当にがっかりだ。いろんなバリエーションを考えるのが Kata 2 の目的な気がするんだけど。なんかもうこう完全にびっくりするぐらい違うのが思いつきたい。