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と出力される.

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

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;

が得られた. 結構大騒ぎだが, もう何クィーンでも対応できるようになった. もっとも引数の個数の制限は別である.

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次とか描くには番号が手引きになるのだろうか.

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)

復活祭公式

今年の復活祭が間もなくだ. 今年はそれもその前の晩に月食があるという豪華版だ. とはいえ私は宗教には無関心で, 復活祭はこのブログに何度か書いたようにその日取りについてだけ興味がある.

復活祭が何かも知らぬ小学校の上級のころ, 大叔父が「今日は復活祭だよ」といい, 手元のSOD(Standard Oxford Dictionary)を開きながら「春分の後の満月の後の日曜」と不思議なことをいったのが興味を持ったきっかけであった.

長ずるに及び, 折がある度に復活祭の日程計算の資料を取り込んできた. ずいぶんいろいろなことが分かってきたが, 今回話題とするのは, 我が愛読書「Calendrical Calculations」の8章The Ecclesiastical Calendarsの扉のページにあるFinger calculation for the date of Easterについてである.


この図の周囲には1582年から1699年, 1700年から1799年, 1800年から1899年の黄金数に対する歳首月齢(epact)の表とドミノ文字(dominical letter)の表があり, もちろん何語か知れぬが(恐らくスペイン語)使い方の記述もある.

最初の表は下のようだ.


[1582]つまりグレゴリオ改暦の年は, 黄金数が6, ドミノ文字がGであったことが分かる. 他にもこういう年の表示が5カ所あるが, 解像度が悪く判読できない.

ドミノ文字は毎年と閏日に1文字ずつ前へ戻る. 従って表を右端から眺めるとまずD, その前年が閏年で3月以降がE, 1,2月がF, 更にその前年がGのようになる.

最後がBからGになるのは改暦のせいだ. 改暦で10日抜けたから, 普通なら1582年のGから1583年はFになるのだが, G,A,Bと3(10 mod 7)日分進み, Bになっている. ここをCに書き直すと, この表は28個の場所があるから, ドミノ文字の一周分になることが分かる.

さて, 1600年はこの表の右端で, 黄金数は(modulo 1600 19)→4だからそれに1足して5. よって歳首月齢は, 5の下の段を見て15. 1月1日の曜日は(modulo (+ 1 (jd 1600 1 1)) 7)→6 だから土曜で, B. 表では右から10個めのABと上下に並ぶのの下3月は下のAになる.

1600年の復活祭は別の資料を見ると4月2日であった.

ここで手の掌の図を見る. 指の内側にあるのが歳首月齢なので, 15を探すと人差し指の左縁のDとある内側に15が見える. そこから右に指の縁を辿り, 最初のドミノ文字Aを探し, その位置を覚えておく.

次に親指の左縁のDのところに22とあるが, これを3月22日として右へ23日, 24日,...と先ほど覚えた位置まで進むと, そこが4月2日になるのである.

指の形はどうでもいいらしいから, 指の縁を直線に延ばして描いたのが次である. 上の線の右端から下の線の左端へ繋がる.

これを見ると歳首月齢が一通り書いてあり(*や24,25だったり,XXVは今は無視), その右隣からドミノ文字が一週分書いてあるのが分かる.




歳首月齢が分かると春分満月も一意に決まる. それがこの線図に赤字で書いたものである. 1600年の例でいえば, 歳首月齢が15だと春分満月が3月29日であり, その直後の日曜は右にドミノ文字を探せばよいわけである.

という次第で, finger calculationとはいうものの, 要はこの対応表だけであった.

西暦年から黄金数は簡単に分かるが, ある年のドミノ文字は西暦年の下2桁を28で割った剰余で表を引くのであろうか. その辺は何語かで書いてあるし, 鮮明さも欠くので, 想像するしかないようだ.

Christopher StracheyのGPM

cal

calというのはある年(ある月)のカレンダーを出力してくれるものである.

cal 3 2015

と入力すると

     March 2015
Su Mo Tu We Th Fr Sa
 1  2  3  4  5  6  7
 8  9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31

が出力される. これは文字ベースだが, pcalはPostScriptで出力が得られるものである. 私は自分で書いたpcalも持っている.

2007年の夏のプログラミング・シンポジウムで私は「いろいろなプログラミング言語によるcalのプログラミング」という題でMMIX, Haskell, PostScript, Scheme, Teco, Texでcalを書いた.

GPMを使っていみていると, GPMでもcalを書いてみたくなるのは人情である. で早速やってみた.

まずはSchemeでロジックを確認しよう. ある月のカレンダーを次のように出力するとして, パラメータa, b, cを次のものとする.

(define (pcal a b c)  ;0<=a,b<7, 3<=c<6
(define (ss) (display "   "))  ;空白3文字出力
(define (dd x y) (display x) (display y) (display " "));xy空白
(define (nn) (newline)) ;改行
(define (r n x y)  ;月末処理 最後の行 xyからn回出力
 (if (> n 0) (begin (dd x y)
  (if (= y 9) (r (- n 1) (+ x 1) 0) (r (- n 1) x (+ y 1))))))
(define (q m n x y)  ;m行目n曜日にxyを出力
 (if (= m 0) (r (- 7 b) x y) ;月末処理へ
  (begin (dd x y)
   (cond 
    ((and (= n 0) (= y 9)) (nn) (q (- m 1) 6 (+ x 1) 0))
    ((and (= n 0) (< y 9)) (nn) (q (- m 1) 6 x (+ y 1)))
    ((and (> n 0) (= y 9)) (q m (- n 1) (+ x 1) 0))
    ((and (> n 0) (< y 9)) (q m (- n 1) x (+ y 1)))))))
(define (p n)     ;月初処理 始めの空白日を出力
 (if (= n 0) (q c (- 6 a) 0 1)
  (begin (ss) (p (- n 1)))))
(p a)
)
(newline)
(pcal 3 2 4)@

これで上手くいったのでgpmへ書き換える. マクロ中の空白や改行に注意.

$def,pcal,<
$def,1+,<$~1,
 $def,~1,<$1,2,3,4,5,6,7,8,9,10,$def,1,<~>>~1<;;>;,
 $def, ,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,nn,
;
$def,ss,   ;
$def,dd,<~1~2 >;
$def,r,<$~1,
 $def,~1,<$dd,>~2<,>~3<;$>~3<,
  $def,>~3<,<$r,$1-,>>~1<<;,>>~2<<,$1+,>>~3<<;;>;,
  $def,9,<$r,$1-,>>~1<<;,$1+,>>~2<<;,0;>;;>;,
 $def,0,;;>;
$def,q,<$~1,
 $def,~1,<$dd,>~3<,>~4<;$>~2~4<,
  $def,>~2~4<,<$q,>>~1<<,$1-,>>~2<<;,>>~3<<,$1+,>>~4<<;;>;,
  $def,>~2<9,<$q,>>~1<<,$1-,>>~2<<;,$1+,>>~3<<;,0;>;,
  $def,0>~4<,<$nn;$q,$1-,>>~1<<;,6,>>~3<<,$1+,>>~4<<;;>;,
  $def,09,<$nn;$q,$1-,>>~1<<;,6,$1+,>>~3<<;,0;>;;>;,
 $def,0,<$r,$-,7,>>~2<<;,>~3<,>~4<;>;;>;
$def,p,<$~1,
 $def,~1,<$ss;$p,$1-,>~1<;;>;,
 $def,0,<$q,>>~3<<,$-,6,>>~1<<;, ,1;>;;>;
$p,~1;
>;
$pcal,3,2,4;

本来のcal, pcalにするには年月をパラメータa,b,cに変換する必要がある. これには400など我々のGPM世界をはみ出す定数が現れるので, 取りあえずはSchemeで書いてある.

年月からpcalのパラメータを求めるプログラム
(define (ym2pcal y m)
 (let* ((p (lambda (n) (= (modulo y n) 0)))
  (q (lambda (n) (quotient y n)))
  (s `(0 3 ,(if (if (p 100) (p 400) (p 4))
   1 0) 3 2 3 2 3 3 2 3 2 3))
  (d (modulo (- (+ 1 y (q 4) (q -100)
   (q 400)) (apply + (list-tail s m))) 7))
  (z (+ (list-ref s m) 28)))
 (list d (modulo (- 42 (+ d z)) 7) 
  (quotient (- (+ d z) 1) 7))))
(map (lambda (m) (ym2pcal 2015 m)) (a2b 1 13)) =>
((4 0 4) (0 0 3) (0 4 4) (3 2 4) (5 6 5) (1 4 4)
 (3 1 4) (6 5 5) (2 3 4) (4 0 4) (0 5 4) (2 2 4))

$pcal,a,b,cがうまくいったので, 今回はこれで満足しよう.

O'Beirneのキューブ

O'Beirneがこれらのピースの形を得た道筋を考えてみた.

24個の単位キューブが2×3×4の空間に並んでいたとする. (下の図の一番上のI) それに図のようにaからxまでのラベルをつける. 左端の2×3の枠が最下段. 右端の枠が最上段で, 順に4段に積んである. それぞれの段には6個の単位キューブがあり, ラベルは図の通りとする.



Iの図の赤線のところで分割し, ずらして合体させると, 再下段では右上のbcfがadeの上に来るからJの図の左端のように変る. 他の段でも同様な図になる. こうしてJが得られる. JからKへの分割面は上から見た図ではうまく表現できないが, 下から2段目のhiが再下段の上へ降りてきて, Kの左のようになる.

周囲の方向の壁にも名前をつける. 上はtop, 下はbot, 水平方向は北, 東, 南, 西で, nor, eas, sou, wesとした.

そして外面と分割面に向う単位キューブを数え上げると次のようなリストが得られる.

(define wall '(
;I
(bot a b c d e f)
(top s t u v w x)
(nor a b c g h i m n o s t u e k q w)
(eas c f i l o r u x a e g k m q s w)
(sou d e f j k l p q r v w x b h n t)
(wes a d g j m p s v b f h l n r t x)

;J
(bot b c a f d e h i m r v w)
(top t u s x v w b c g l p q)
(nor b c h i n o t u p q g l)
(eas c f e i l k o r q u x w)
(sou d e j l p q v w m r h i)
(wex b a c h g j n m p t s v)

;K
(bot h i b c a f d e n m g j u x w q)
(top t u s x v w p q h b a d o r l k)
(nor h i n o t u)
(eas i c f e o r l k u x w q n m g j)
(sou d e j k p q)
(wes h b a d n m g j t s v p o r l k)

;L
(bot n h i m b c g a f j d e)
(top t u o s x r v w l p q k)
(nor n h i t u o m a e s w k)
(eas i c f e o r l k m a s w)
(sou j d e p q k n b f t x l)
(wes n m g j t s v p b f x l)

;M
(bot m n h i g a b c j d e f v w x r)
(top s t u o v w x r p q k l g a b c)
(nor m n h i s t u o g a b c p q k l)
(eas i c f o r l)
(sou j d e f p q k l m n h i v w x r)
(wes m g j s v p)

;N
(bot g a b c j d e f n q u x)
(top s t u o v w x r a d h k)
(nor g a b c m n h i s t u o)
(eas c f i l o r g j n q u x)
(sou j d e f p q k l v w x r)
(wes g j m p s v a d h k o r)
))

ちょっとしたプログラムで処理すると, それぞれのキューブで外面に向いていない方向が得られる.

((a sou) (b eas) (c sou wes) (d nor eas) (e top wes) (f top nor)
 (g sou) (h eas) (i top wes) (j top nor) (k bot) (l bot) (m top)
 (n top) (o bot sou) (p bot eas) (q wes) (r nor) (s bot sou)
 (t bot eas) (u sou wes) (v nor eas) (w wes) (x nor))

ここはキューブが離ればなれにならない向き, つまりキューブが繋がっている方向なので, Iの図に接続の様子を赤字で書き込んでみる. 矢印はそこで水平方向に 繋がっていることを示す. 丸の中の点とプラスは電流の記号と同じで, 丸に点は上向きに, 丸にプラスは下向きに繋がっていることを示す.



これを眺めながら, 前回のブログの6種のピースと対応させると

adek C+
bcfl A-
gjpq B+
hior B-
msvw A+
ntux C-

うまくいったなぁ. O'Beirneもこう考えたのかな.