2015年4月27日月曜日

Christopher StracheyのGPM

順列の生成


n個の要素のすべての順列を生成するのも情報科学標準問題である.

私のSchemeのライブラリには
(define (permutation ls) ;list of permutation of ls
 (define (list-del l n)
   (if (= n 0) (cdr l)
    (cons (car l) (list-del (cdr l) (- n 1)))))
  (if (null? ls) '(())
   (apply append (map (lambda (i)
    (let ((x (list-ref ls i)))
     (map (lambda (p) (cons x p))
       (permutation (list-del ls i))  )))
      (a2b 0 (length ls))))))
;(permutation '(a b c))=>
;((a b c) (a c b) (b a c) (b c a) (c a b) (c b a))
というのが置いてある.

(list-del l n)はlのn番目の要素を取り去ったリストを返す. 本体は順列をとるリストが空なら空リストのリストを返す. そうでないなら最後の行(a2b 0 (length ls))でlsが(a b c)なら(0 1 2)のリストを作り, その各々を(lambda (i)..)のiとして(let..以下をやったものをappendする.

(let以下のxはlist-refだからa,b,cになり, それぞれlist-delした(b c) (a c) (a b)の順列の先頭に付ける. だから(a b c) (a c b) (b a c) (b c a) (c a b) (c b a)をappendすることになり, (a b c)の順列が完成する.

さてgpmには配列もリストもないから, また引数列を活用するプログラムを考えなければならない. 引数の長さに従って別のマクロを用意しなければならない.

そう考えて書いたのが次だ.
$def,p2,<~1~2~3>;
$def,p3,<$p2,~1,~2,~3;
$p2,~1,~3,~2;>;
$def,p4,<$p3,~1~2,~3,~4;
$p3,~1~3,~2,~4;
$p3,~1~4,~2,~3;>;
$def,p5,<$p4,~1~2,~3,~4,~5;
$p4,~1~3,~2,~4,~5;
$p4,~1~4,~2,~3,~5;
$p4,~1~5,~2,~3,~4;>;
これはまずp5を$p5,,a,b,c,d;のように呼ぶ. 第1引数が空, 第2引数以降がa,b,c,d である.

そこでp5の定義を見ると, $p4,空a,b,c,d;$p4,空b,a,c,d;$p4,空c,a,b,d;$p4,空d,a,b,c;とp4を呼び出している. つまりp4の第1引数は上のSchemeのプログラムのx, 以降はlist-delの結果に対応している.

p4の定義を見ると, $p3,~1~2,~3,~4;と呼ぶから, 最初のp4の呼出からは$p3,空ab,c,d;$p3,空ac,b,d;$p3,空ad,b,c;と呼出され, その最初のp3の呼出では$p2,空ab,c,d;$p2,空ab,d,c;と呼出され, p2によってabcd, abdcと出力される.

なんだか全部の順列を自分で書いたみたいな気もするが, これで完成である. 引数の数だけマクロを用意するのは面倒だが, それを我慢すれば存外簡単であった.

2015年4月26日日曜日

Christopher StracheyのGPM

クィーンパズル生成マクロ


前回は4クィーン問題をGPMで解いてみたが, そもそもは8クィーンを解きたい.

すこし時間が経ったのでおさらいするとして, q2とq3を並べて見る.

$def,q3,<$z,0,                  $def,q2,<$y,0,                  
 $def,z,<$~1,                    $def,y,<$~1,                   
 $def,~1,<$                      $def,~1,<$                     
  $|,$?,>>~1<<,>~1<,0;,           $|,$?,>>~1<<,>~1<,0;,         
  $|,$?,>>~1<<,>~1<,3;,           $|,$?,>>~1<<,>~1<,2;,         
  $|,$?,>>~2<<,>~1<,0;,           $|,$?,>>~2<<,>~1<,0;,         
  $|,$?,>>~2<<,>~1<,2;,           $?,>>~2<<,>~1<,1;;;;,         
  $|,$?,>>~3<<,>~1<,0;,                                         
  $?,>>~3<<,>~1<,1;;;;;;,                                       
  $def,f,<$q4,>>>~1<<<,>>>~2<<<,  $def,f,<$q3,>>>~1<<<,>>>~2<<<,
   >>>~3<<<,>>~1<<,>>>~4<<<;       >>~1<<,>>>~3<<<;             
   $z,$1+,>>~1<<;;>;,              $y,$1+,>>~1<<;;>;,           
  $def,t,<$z,$1+,>>~1<<;;>;;>;,   $def,t,<$y,$1+,>>~1<<;;>;;>;, 
 $def,>~4<,;;>;;>;               $def,>~3<,;;>;;>;              
q2は$q2,0,2,4; $q2,0,3,4; のように既に2個のクィーンが無事に置けたとしてそれらのクィーンの位置と4クィーンであるという4をもって呼ばれる. 3個めを0,1,2,3と置いてみて, うまく置ければそれを次の引数に追加してq3を呼ぶ仕掛である.

3個めを置くマクロはyで, $y,0;と呼ぶ. 続けてyの定義がある. まず引数が~3, つまりnクィーンのnなら終りのチェックをするが, 例によってelseから書いてある. else節はor(|)で$?をいくつも呼んで, 引数で持ち込まれたクィーンと当るかを調べる.

$?,>>~1<<,>~1<,0;は最初のクィーンと今度のクィーンが横並びか見る. (>>~1<<が最初のクィーン, >~1<がyが作った新しいクィーン.) 次の?はクィーンが横方向に2ずれているから, 高さ方向の差が2であるか見る.

次は2番目のクィーンと今度のクィーンが横並びか高さの差が1かを見る.

orが偽をいうことは, 無事に置けたのだから, 受け取った引数と, 今回テスト中のクィーンとnの値4をもってq3を呼び, 今回のクィーンの位置をひとつ増してyを呼ぶ.

新しい位置が当っていれば, $def,t,にあるように, 位置を増してyを呼ぶ.

新しいクィーンの位置がnまで来ると最後の方の$def,>~3<,で, そのまま脱出してしまう.

これが別れば一般のクィーンの個数のqマクロが書ける.

しかしマクロを生成するマクロには宿命がある. 評価を阻止する<と>について, 出力マクロに入れるものか, 現状の評価中に評価を阻止するためのものか, 区別が必要なことである.

今回は出力に書き出すものは, [と]を使うことにした. 出来上がったマクロをエディタで処理し, [,]を<,>に置き換える.

$def,g0,<$~1,
$def,~1,<
<  $|,$?,]]~>$-,>~2<,>~1<;<[[,]~1[,0;,>
<  $|,$?,]]~>$-,>~2<,>~1<;<[[,]~1[,>>~1<<;,>
    $g0,$1-,>~1<;,>~2<;>;,
$def,1,<
<  $|,$?,]]~>$-,>~2<,>~1<;<[[,]~1[,0;,>
<  $?,]]~>$-,>~2<,>~1<;<[[,]~1[,>>~1;;>;
$def,g1,<$~1,
$def,~1,<;;$g1,$1-,>~1<;;>;,
$def,0,;;>;
$def,g2,<$~1,
$def,~1,<<]]]~>$-,>~2<,>~1<;<[[[,>
   $g2,$1-,>~1<;,>~2<;>;,
$def,0,;;>;

$def,gen,<
<$def,q>~1<,[$>~2<,0,>
< $def,>~2<,[$~1,>
< $def,~1,[$>$g0,~1,$1+,~1;;$g1,~1;<,>
<   $def,f,[$q>$1+,~1;<,>
  $g2,~1,$1+,~1;;<]]~1[[,]]]~>$1+,~1;<[[[;>
<   $>~2<,$1+,]]~1[[;;];,>
<  $def,t,[
$>~2<,$1+,]]~1[[;;];;];,>
< $def,]~>$1+,~1;<[,;;];;];>
>;
この$genが生成マクロである. $gen,3,z;のように呼ぶ. するとq3が出力される. zは上のq2の例にあったyの働きのものである.

真中より少し下のgenの定義を見ると,

<$def,q>~1<,[$>~2<,0,>
< $def,>~2<,[$~1,>
< $def,~1,[$>
とあって, これで
$def,q3,[$z,0,
 $def,z,[$~1,
 $def,~1,[$
までが出来る. 次のg0はorの連続を出力, g1はその後のセミコロンの列を出力する. さらに先のg2はq4の呼出し列を生成する. そういう次第で出力されたq3は
$def,q3,[$z,0,
 $def,z,[$~1,
 $def,~1,[$
  $|,$?,]]~1[[,]~1[,0;,
  $|,$?,]]~1[[,]~1[,3;,
  $|,$?,]]~2[[,]~1[,0;,
  $|,$?,]]~2[[,]~1[,2;,
  $|,$?,]]~3[[,]~1[,0;,
  $?,]]~3[[,]~1[,1;;;;;;,
   $def,f,[$q4,]]]~1[[[,]]]~2[[[,]]]~3[[[,]]~1[[,]]]~4[[[;
   $z,$1+,]]~1[[;;];,
  $def,t,[$z,$1+,]]~1[[;;];;];,
 $def,]~4[,;;];;];
ほかのq1,q2,...,q7も以下の呼出しで生成される.
$gen,7,d;
$gen,6,c;
$gen,5,b;
$gen,4,a;
$gen,3,z;
$gen,2,y;
$gen,1,x;
その出力のかっこを変換し, 両端の
$def,q8,<~1,~2,~3,~4,~5,~6,~7,~8;>;
$def,q0,<$w,0,
 $def,w,<$~1,
 $def,~1,<$q1,>~1<,>>~1<<;
  $w,$1+,>~1<;;>;,
 $def,>~1<,;;>;;>;
を追加し, $q0,8; で呼ぶと, 約28分の実行の後
0,4,7,5,2,6,1,3;0,5,7,2,6,3,1,4;
0,6,3,5,7,1,4,2;0,6,4,7,1,3,5,2;
1,3,5,7,2,0,6,4;...
...
7,2,0,5,1,4,6,3;7,3,0,2,5,1,6,4;
が得られた. 結構大騒ぎだが, もう何クィーンでも対応できるようになった. もっとも引数の個数の制限は別である.

2015年4月23日木曜日

McGregorグラフ

TAOCPに「10次のMcGregorグラフ(McGregor graph of order 10)」という図があった. これには「Scientific Americanの1975年4月号で, Martin Gardnerがこの図の塗り分けには5色が必要と紹介し世間を驚かせた」と説明がある.



その号のMathematical Gamesコラムに はeπ√163は整数である(これについては高橋秀俊先生が1975年の高橋コンファレンスで話された. どこかにそれが書かれているかと探したが見当たらない.)とか怪しい話もあり, 結局は四月馬鹿の話題であったのだ.

私もその号のコラムを読み, なーんだと思ったひとりである. それから既に40年経った.

TAOCPには演習問題の解を見る前に自分で試みよとあったので, とりあえずバックトラックしながら解を探すプログラムをSchemeで書き, 解をひとつ見つけた. 結構時間が掛ったが, プログラムを走らせてから長めのミーティングに出ていて, 戻ってきたら解が出力されていた.

ちゃんと4色で塗れた. 探索プログラムより区画どうしの接続データを作るのが面倒であった. またこの図を描くPostScriptのプログラムも予想外に時間がかかった.

接続データはこういう形である.
(0 1 10 11 100 101 102 103 104 105 109)
(1 0 2 11 12 109)
(2 1 3 12 13 109)
(3 2 4 13 14 109)
(4 3 5 14 15 109)
(5 4 6 15 16 109)
... 途中100行省略
(106 10 95 96 105 107)
(107 10 96 97 106 108)
(108 10 97 98 107 109)
(109 0 1 2 3 4 5 6 7 8 9 10 9 19 98 108)))
例えば最上行は「0の区画と隣合うのは1, 10, 11, a0, a1, a2, a3, a4, a5, a9である」という意味. aは10 と書いてある. もちろんaの隣のリストにあるbについて, bの隣のリストにaがあることはチェックした.

得られた解で塗り分けたのが下の図である. かなり美しい.



110の区画でそれぞれの色が使われた数はであった. と書いた理由はTAOCPにひとつの色は7区画でしか使わない解があるという記述があったからだ. そういう解を探すのはまた大変そうだ.

TAOCPではこれをdancing linksで解くつもりらしい. dancing linksのプログラムは以前に書いたこともあるので, そのうちdancing linksでもプログラムを書いてみたい.

ところで各区画に付いている番号には意味があるのかな. 上の図は10次だが, 9次とか描くには番号が手引きになるのだろうか.

2015年4月22日水曜日

Christopher StracheyのGPM

4クィーンパズル


バックトラックしながら全解探索する情報科学標準問題である. 普通の言語なら配列を使うわけだが, GPMでやってみようと思うと, 配列がないのでまず困る.

今回は部分解を引数の列で持ち回ることにした. つまりnクィーンを解くとしてマクロq0は第0列のs=0,1,..,n-1にクィーンを置き, sを引数としてq1を呼ぶ. q1は第1列のt=0,1,..,n-1のクィーンがsと当たっていなければ, s,tを引数としてq2を呼ぶ. ... のように作る.



クィーン同士が当るかどうかみるのにマクロ$?,a,b,d;を用意する. a,bがd離れているかみるもので, Schemeで書けば

(define (? a b d) (= (abs (- a b)) d))

となる.
$def,1+,<$1,2,3,4,5,6,7,8,9,10,
 $def,1,<~>~1;;>;
$def,1-,<$-1,0,1,2,3,4,5,6,7,8,
 $def,-1,<~>~1;;>;
$def,-,<$~2,
 $def,~2,<$-,$1-,>~1<;,$1-,>~2<;;>;,$def,0,~1;;>;
$def,lt,<$~1,
 $def,~1,<$lt,$1-,>~1<;,>~2<;>;$def,-1,t;$def,~2,f;;>;
$def,|,<$~1,$def,~1,t;,$def,f,~2;;>;
$def,?,
 <$$lt,~1,~2;,
  $def,t,<$$-,>~2<,>~1<;,
   $def,$-,>~2<,>~1<;,f;,
   $def,>~3<,t;;>;,
  $def,f,<$$-,>~1<,>~2<;,
   $def,$-,>~1<,>~2<;,f;,
   $def,>~3<,t;;>;;>;
q4はすべての列に置けたので出力するから
$def,q4,<~1,~2,~3,~4;>;
第3列に置いてみるq3は
$def,q3,<$z,0,
 $def,z,<$~1,
 $def,~1,<$
  $|,$?,>>~1<<,>~1<,0;,
  $|,$?,>>~1<<,>~1<,3;,
  $|,$?,>>~2<<,>~1<,0;,
  $|,$?,>>~2<<,>~1<,2;,
  $|,$?,>>~3<<,>~1<,0;,
  $?,>>~3<<,>~1<,1;;;;;;,
  $def,f,<$q4,>>>~1<<<,>>>~2<<<,>>>~3<<<,>>~1<<,>>>~4<<<;
   $z,$1+,>>~1<<;;>;,
  $def,t,<$z,$1+,>>~1<<;;>;;>;,
 $def,>~4<,;;>;;>;
q2, q1, q0も同様で
$def,q2,<$y,0,
 $def,y,<$~1,
 $def,~1,<$
  $|,$?,>>~1<<,>~1<,0;,
  $|,$?,>>~1<<,>~1<,2;,
  $|,$?,>>~2<<,>~1<,0;,
  $?,>>~2<<,>~1<,1;;;;,
  $def,f,<$q3,>>>~1<<<,>>>~2<<<,>>~1<<,>>>~3<<<;
   $y,$1+,>>~1<<;;>;,
  $def,t,<$y,$1+,>>~1<<;;>;;>;,
 $def,>~3<,;;>;;>;
$def,q1,<$x,0,
 $def,x,<$~1,
 $def,~1,<$
  $|,$?,>>~1<<,>~1<,0;,
  $?,>>~1<<,>~1<,1;;,
  $def,f,<$q2,>>>~1<<<,>>~1<<,>>>~2<<<;
   $x,$1+,>>~1<<;;>;,
  $def,t,<$x,$1+,>>~1<<;;>;;>;,
 $def,>~2<,;;>;;>;
$def,q0,<$w,0,
 $def,w,<$~1,
 $def,~1,<$q1,>~1<,>>~1<<;
  $w,$1+,>~1<;;>;,
 $def,>~1<,;;>;;>;
と準備出来たから実行してみる.
$q0,4; => 1,3,0,2;2,0,3,1;
4クィーンには双対のこの解しかない.

同様に引数渡しをするのでも, やはりSchemeのようにさっさっさとはいかない. Scheme版はこうだ.
(define (q0 n) (do ((s 0 (+ s 1))) ((= s n)) (q1 s n)))
(define (q1 s n) (do ((t 0 (+ t 1))) ((= t n))
 (cond ((? s t 0)) ((? s t 1))
       (else (q2 s t n)))))
(define (q2 s t n) (do ((u 0 (+ u 1))) ((= u n))
 (cond ((? s u 0)) ((? s u 2)) ((? t u 0)) ((? t u 1))
       (else (q3 s t u n)))))
(define (q3 s t u n) (do ((v 0 (+ v 1))) ((= v n))
 (cond ((? s v 0)) ((? s v 3)) ((? t v 0)) ((? t v 2))
       ((? u v 0)) ((? u v 1))
       ((= n 4) (display (list s t u v)))
       (else (q4 s t u v n)))))
(q0 4) ;=> (1 3 0 2)(2 0 3 1)