小学生のとき僕の住んでいた田舎では、ラジオ体操のスタンプカードは、子供にとっての夏のシンボルのひとつだった。近所のラジオ体操会場(公園など)に毎朝通って出席印を捺してもらうのだ。 このような「何か小さな達成のたびに升目を埋めていく」もののひとつに、文字を升目に区切ったものを塗りつぶしていくタイプのものがある。

ちょっと想像するだけで、升目の数を希望した通りに作るのが難しそうだ。例えば、右の「竜」の升目の総数は、ちょうど 800 個。
こういうの、パソコンが今ほど一般的になるよりも以前から見かけた気がするのだが、拡大率をいろいろ変えてコピーした方眼紙を大書した文字に重ねて、重なる升目が希望した数に近くなるようなところを探すとかしてたのだろうか。想像するだけで大変そう。

ところで、いまパソコン画面で見るすべての文字は、虫眼鏡で拡大してみるとピクセルという四角形(升目)でできている。ということは、文字を形作るピクセルの数が希望した数になるように文字の大きさを調節すれば、希望するような升目の集合を作れそうだ。

というわけで Mathematica である。
Mathematica 7 で、文字の大きさを変えてピクセルを数えたりするのはそんなに難しくない。だが、ふたつほど、考えておかなければならないことがある。

ひとつ目は、アンチエイリアス。
最近は、画面上でぎざぎざを感じさせない表示を実現するために、黒い文字を表示するときにも、字画に含まれる斜め線などを、黒でない中間調の色のピクセルも使って表示する。例えば、僕の席の Mathematica で

Rasterize[Style["xYz", FontFamily -> "Helvetica"]]

の結果を、マウスドラッグで大きくすると、実にいろいろな色のピクセルが使われていることが分かる。

ピクセルの数を数えるには、ピクセルの色が揃っていた方が都合が良い。いくつかやり方がありそうだが、今回は単純に Rasterize の結果を ver.7 の新関数 Binarize にかけてできる白黒二値画像でいくことにする。

もう一つの問題は、必ずしもいつでも希望通りの升目数にできるわけではないことだ。
例えば、「一(漢数字の1)」の文字の大きさを少しずつ大きくしていくと、字画の太さが1ピクセルつまり1升目ぶん太くなったとき、ピクセルの総数は字画の長さに近しい数だけ増えてしまう。ピクセルの総数を1ずつ増やせるとは限らないということだ。

また、上述のアンチエイリアスとの兼ね合いなのか、文字の大きさに対して、升目の総数が単調増加でない、つまり、文字を少し大きくすると升目総数が逆に少なくなってしまうこともある。下のグラフは、上と同じ「一」の文字から作った升目の数と文字の大きさの関係で、文字の大きさが増加しても升目の総数は増えたり減ったりしていることが分かる。

今回は、希望した升目の数に対して、できあがりの升目の数が下回らないようにし、多すぎた場合は、はみ出た個数だけランダムに斜線を入れることにした。1000 マスを希望して 1044 マスになった場合、 44 マスに斜線をひいておき、斜線のない升目の数が 1000 になるようにするのだ。斜線の升目はボーナスとして無条件に塗ることにして使えば困らないだろうとのコテサキ考えだ。

というわけで、とりあえず書いてみたのが次のコード。升目の数を希望に近づけるのに、 NMinimize を使って数値的に探索しているので、実行には数分かかってしまう。NMinimize のオプションを工夫することで多少の高速化は可能かもしれない。

str = "合格";  (* 升目にしたい文字列 *)
target = 1000;  (* 希望する升目数 *)
(* 文字を白黒二値(1, 0)のマトリックスに変換する関数 *)
rst[fsize_] := ImageData[Binarize[Rasterize[
  Style[str, FontSize -> fsize, FontFamily -> "ヒラギノ角ゴ Std W8"]]]]
(* 黒ピクセル数と目標値の差分を計算する関数 *)
tgf[fsize_?NumericQ] := Count[rst[fsize], 0, {2}] - target
(* 差分の最小化 *)
sol = NMinimize[{tgf[fsize], tgf[fsize] >= 0}, {{fsize, 10, 100}}]
(* 升目と斜線を描画 *)
masu = Rectangle[#, # + 1] & /@
  Reverse /@ Position[Reverse@rst[fsize /. sol[[2]]], 0, {2}];
Graphics[{White, EdgeForm[Thin], masu, Black,
  Line[List @@ #] & /@ RandomSample[masu, Floor@sol[[1]]]}]

ちなみに、Windows 環境でいろいろな字体を試すには、関数 rst にある字体の指定を次のようにする必要がある。

FontFamily ->
   FromCharacterCode[ToCharacterCode["MS Pゴシック", "ShiftJIS"]]


いまも、ラジオ体操のスタンプカードって、続いているのだろうか。

※この記事の内容は執筆者の個人的見解で、ヒューリンクスによる公式情報ではありません。[免責事項]

トラックバック

この記事へのトラックバックURL
http://blog.hulinks.co.jp/cgi/mt/mt-tb.cgi/436
内容に対しての関連性がみられないものは削除する場合があります

コメントの投稿

Emailアドレスは表示されません。は必須項目です。
ヒューリンクス取り扱い製品の内容や購入に関するお問い合わせはヒューリンクスサイト連絡先へお願いいたします。投稿前にその他の注意事項もご覧ください。