この記事は ひとりアドベントカレンダーRosettaCodeで楽しむプログラミング Advent Calendar 2025の19日めの記事です。
定義
10進法で表記したとき、隣接する数字が互いに素数だけ異なってるような数。
タスク
- 100超500未満のstrange numbersを全て示せ。
- (stretch goal) 10桁のstrange numbersで、1で始まるものはいくつあるか。
考える
差が素数といっても、どうせ1桁での話なので、大したバリエーションはない。
次に来ることができる数字を書き出しても大したことない。
| 数字 | 次の数字 |
|---|---|
| 0 | 2,3,5,7 |
| 1 | 3,4,6,8 |
| 2 | 0,4,5,7,9 |
| 3 | 0,1,5,6,8 |
| 4 | 1,2,6,7,9 |
| 5 | 0,2,3,7,8 |
| 6 | 1,3,4,8,9 |
| 7 | 0,2,4,5,9 |
| 8 | 1,3,5,6 |
| 9 | 2,4,6,7 |
欲しいstrange numberの桁数と、最上位桁の数字を与えられたとき、それを全て挙げるプログラムが書ける。
gen :: Int -> Int -> [Int]
gen k0 d0 = go k0 d0 d0
where
go 1 _ v = [v]
go k d v = concat
[ go (pred k) e (v * 10 + e)
| p <- [-7, -5, -3, -2, 2, 3, 5, 7]
, let e = d + p, 0 <= e, e <= 9]
これでタスク1は簡単に達成できる。
task1 :: [Int]
task1 = concat [gen 3 i | i <- [1 .. 4]]
ghci> task1
[130,131,135,136,138,141,142,146,147,149,161,163,164,168,169,181,183,185,186,202
,203,205,207,241,242,246,247,249,250,252,253,257,258,270,272,274,275,279,292,294
,296,297,302,303,305,307,313,314,316,318,350,352,353,357,358,361,363,364,368,369
,381,383,385,386,413,414,416,418,420,424,425,427,429,461,463,464,468,469,470,472
,474,475,479,492,494,496,497]
(0.18 secs, 921,456 bytes)
ghci> length it
87
タスク2もできてしまうのでは？
task2 :: Int
task2 = length $ gen 10 1
ghci> task2
853423
(6.34 secs, 1,789,178,488 bytes)
できました！おわり！…では芸がない。
無駄のない計算
gen の中で生成している数を、末尾の数字ごとにそのような数はいくつあるか、という表に置き換えて、数字ごとに足し合わせて集計すれば、数を実際に列挙することなく、最上位桁の数字と桁数から作られるstrange numbersの個数だけを数えることができる。基本のDP。
import Data.Array
task2a :: Int
task2a = sum $ elems $ iterate step arr0 !! 9
where
arr0 = accumArray (+) 0 (0,9) [(1,1)] -- 最上位桁は1
step arr = accumArray (+) 0 (0,9)
[ (e,c) | (d,c) <- assocs arr
, p <- [-7, -5, -3, -2, 2, 3, 5, 7]
, let e = d + p, 0 <= e, e <= 9 ]
ghci> task2a
853423
(0.01 secs, 433,840 bytes)
concatを排除
gen で使っている concat は計算量の敵なので排除するのがHaskell固有の最適化の基本。
gen1 :: Int -> Int -> Int -> [Int] -> [Int]
gen1 1 _ v rest = v : rest
gen1 k d v rest = foldr ($) rest
[ gen1 (pred k) e (v * 10 + e)
| p <- [-7, -5, -3, -2, 2, 3, 5, 7]
, let e = d + p, 0 <= e, e <= 9]
task1b :: [Int]
task1b = foldr (\d rest -> gen1 3 d d rest) [] [1 .. 5]
task2b :: Int
task2b = length $ gen1 10 1 1 []
ghci> task2b
853423
(4.45 secs, 913,895,056 bytes)
generate & test style
Rosetta Code にあるHaskell版は、範囲の全ての数を列挙して、isStrange で条件を満たすか判定している。
generate & test は Haskell らしいと言えなくもないが、この問題にそれを適用するのは悪手でしかないでしょう。
100 から 129 までの数は、1-0, 1-1 が素数差でないのでそれより下の桁は考えるまでもないのに、構わず全部やるというのは、富豪的というより…
ghci> main
[略]
(0.05 secs, 5,133,448 bytes)
オシャレに出力している場合じゃないんよ。
ghci> length $ filter isStrange [1_000_000 .. 1_999_999]
8547
(8.06 secs, 11,642,587,176 bytes)
ghci> length $ gen1 7 1 1 []
8547
(0.04 secs, 9,230,152 bytes)
ghci> length $ filter isStrange [10_000_000 .. 19_999_999]
39630
(87.46 secs, 117,180,916,416 bytes)
ghci> length $ gen1 8 1 1 []
39630
(0.13 secs, 42,534,784 bytes)
あと2桁増やしたら100倍の時間がかかるのよ。
9,000 秒って2時間半ですよ。DPすら使わずに5秒でできる計算だのに。