自宅のトイレにはディック・ブルーナのポスターがもう何年も張ってある。全体がグリッドに仕切られていて、そのひとつひとつに彼の代表作から抜き出した絵が並べられてるんだけど、そのうちの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色で塗り分けるパターンをすべて求めたい。
いま、都合よく R という関数があって、これを使うと2マスを3色で塗り分けパターンが全部求められるとしよう。R を使えば、以下の 3つの結果をよせ集めることで、3マスの塗り分けパターンを求めることができる。
- Aを緑に塗って、BとCは R に従って塗り分ける全パターン
- Aを黒に塗って、BとCは R に従って塗り分ける全パターン
- 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
16 = 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\"> </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の引数は順番を逆にするべきだったな。行と列がいれかわってて紛らわしいことこのうえない。
