数学ガールのミルカさんが「こうなる」とひと言発する間にやっていること(ウラムの螺旋)

4797374152結城浩『数学ガールの秘密ノート 整数で遊ぼう』(SBクリエイティブ, 2013)(索引あり・参考文献リストあり)にウラムの螺旋が出てきます。

100くらいまで描いたところで、

「あ、あたしっ、この先にも興味があります。ぐるぐるぐるぐるぐるぐるぐる……とずっと続けたらどんな図形が表れるんでしょう」

と言うテトラちゃんに応えて、

「こうなる」

と言ってミルカさんがかなり大きなウラムの螺旋を見せています。(p.70)

「ウラムの螺旋」で検索すればぱっと出せそうな気もしますが(インタラクティブなものなんかも)、本書で描かれているのは1から始まるよくある螺旋ではなく、0から始まる螺旋なので、そうでもないかもしれません。そもそもミルカさんは、「こうなる」といいながらウェブ検索をするキャラではありません。

ですから彼女は、「こうなる」とひと言発するわずかの時間でウラムの螺旋を描くスクリプトを書いているんだと思うのです。(彼女はノートPCを持ち歩いている設定でしたっけ?)

そんなことができるのかと思って最初に思いつくのはこんなスクリプトです(Mathematica)。

spiral[size_, start_] := With[{center = Ceiling[(2 size - 1)/2]},
  Module[{
    m = Table[start, {2 size - 1}, {2 size - 1}],
    i = start},
   Do[
    Do[m[[r, center + k]] = ++i, {r, center + k - 1, center - k, -1}];
    Do[m[[center - k, c]] = ++i, {c, center + k - 1, center - k, -1}];
    Do[m[[r, center - k]] = ++i, {r, center - k + 1, center + k, 1}];
    Do[m[[center + k, c]] = ++i, {c, center - k + 1, center + k, 1}],
    {k, 1, size - 1}];
   ArrayPlot[PrimeQ[m] /. {True -> 1, False -> 0}]]]

これで「spiral[4, 0]」などとすればウラムの螺旋を描けますが、会話のテンポはかなり遅くなるでしょう。

会話のテンポを自然なものに保つためには、もっとコンパクトなスクリプトを書けなければなりませんが、すぐには思いつきません。(かつて書いたスクリプトがノートPCに保存してあった?)

というわけで、彼女は優秀な高校生だという物語の設定は、そのとおりだと思いました。

会話形式で書かれている数学ガールには、会話のペースに合わせてできるものだろうかと考えながら読む楽しみがあります。

せっかくなので、サイズを大きくしたときの変化を見てみましょう。

Animate[spiral[size, 1], {size, 1, 100, 1}]

サイズを大きくしたときの変化

中心の数を変化させたときの様子も見てみましょう。

Animate[spiral[50, start], {start, 0, 100, 1}]

中心の数を0から100まで変化させた様子

Wolfram CDF Playerがインストールされていれば、インタラクティブに調べられます。