大人の塗り絵:塗り分けに五色必要な地図(1975年のエイプリルフール)


4102184619四色あれば,地図上の隣り合う領域の色が同じにならないように塗り分けられるという「四色定理」は,1800年代後半に予想され,1976年にコンピュータを使って「証明」された。

定理が「証明」される前の1975年に,マーチン・ガードナーが塗り分けに五色必要だとして発表した次の絵が話題になったという。(参考:Martin Gardner's April Fool's Map

これはエイプリルフールのネタだったのだが,四色で塗り分けたという手紙が数百通届いたらしい。(ロビン・ウィルソン『四色問題』(新潮社, 2013)p.38)

この大人の塗り絵をやってみたい。

0387753664Mathematica in Action で,塗り分ける方法が紹介されているのだが,http://extras.springer.com/からダウンロードできるコードは,最近のMathematicaでは動かない。(Mathematicaの言語仕様は後方互換性を保持しながら進化しているのだが,外部パッケージが本体に取り込まれた場合は,大抵うまくいかない。)

そこで,簡易版を作る。領域の境界線が垂直または水平の2pxの黒い実線の場合にのみ対応するという意味で「簡易」である。

Importで画像を読み込み,MorphologicalComponentsで領域に分割する(Colorize[matrix]で描画)。

四色で塗り分ける。(参考:ヨーロッパの地図の4色を求める

色を1組の真偽値で表し,色が同じでないという条件を連言標準形で記述することで,高速化している。

細かい注意:上の結果は周りが海に囲まれていても大丈夫なように,条件を追加して求めたもので,このコードの結果とはちょっと違うものになっている。

最後の描画はColorize[matrix, ColorRules -> cTable]でもいいのだが,この関数にはバグがあり,Mathematica 10.4.1では正しく動作しない。(製造元には報告済み。Ver.11で修正された。

Mathematica 10.4のRegionPlotのバグ


10.3.1ではできたことが,

10.4でできなくなってしまいました(10.4.1, 11もダメ)。(報告済み)

Mathematicaのサジェスチョンバーはオフにすべき(10.4)(10.4.1で修正)


10.4.1で直ったようです。

Mathematica 9で導入されたサジェスチョンバーのせいで計算結果がおかしくなることがあるようです。テクニカルサポートにバグを報告したら,その回答として教えてもらいました。

例1:以下のコードを1行ずつ実行するとMathematicaが落ちます。

m = SparseArray[{{0, 1, 0}, {1, 0, 1}, {0, 0, 0}}];

n = Map[With[{s = Total[#]}, If[s == 0, #, #/s]] &, Normal[m]];

n.n

例2:以下のコードを1行ずつ実行するとコンテキストが勝手に変わってしまいます。

Context[]

f = Solve[{2 x + y == p, x - 2 y == q}, {x, y}][[1]];

x + y ≤ 4 /. f

Context[]

せっかくフロントエンドとカーネルを分けているのにどうしてこんなことになるのか不思議ですが,文句を言っても計算結果は変わらないので,以下の資料に従って,サジェスチョンバーはオフにしておきましょう。

入力予測インターフェースの機能をオフにする方法