この記事は ひとりアドベントカレンダーRosettaCodeで楽しむプログラミング Advent Calendar 2025の2日めの記事です。
定義
正整数 $N$ であって、$1 < B < N-1$ の範囲の自然数 $B$ で、基数 $B$ で $N$ を表したとき全ての数字が同じになるような $B$ が少なくともひとつ存在する数。
タスク
- ブラジリアン数の最初の20個を挙げよ
- 奇数のブラジリアン数の最初の20個を挙げよ
- 素数のブラジリアン数の最初の20個を挙げよ
考える
自然数 $N$ が与えられたとき、それがブラジリアン数かどうかを判定するには、2からN-1までのBを仮定して、基数Bで表現してみて数字が揃えばよい。
しかし、基数Bで表現するには $\log N$ 回の除算が必要で、それを $N$ 回試す必要があるので、結構計算量が重そう。
さらにそれを N を順にしらみつぶしすると $O(N^2 \log N)$ になってしまう。
ということで、違うアプローチを考えてみる。
基数 $B$ のゾロ目の数は、まずrepunitが $1, 1+B, 1+B+B^2, 1+B+B^2+B^3, \cdots$ とあって、それに$1 \leq D \leq B-1$ を掛けることで全て作り出すことができる。
zollo :: Integer -> [Integer]
zollo b = [ru * k | ru <- iterate (succ . (b *)) 1, k <- [1 .. pred b]]
-- 乗算を嫌う別解
zollo b = [x | ru <- iterate (succ . (b *)) 1, x <- genericTake (pred b) [ru, ru + ru ..]]
> take 16 $ zollo 2
[1,3,7,15,31,63,127,255,511,1023,2047,4095,8191,16383,32767,65535]
> take 63 $ zollo 10
[1,2,3,4,5,6,7,8,9
,11,22,33,44,55,66,77,88,99
,111,222,333,444,555,666,777,888,999
,1111,2222,3333,4444,5555,6666,7777,8888,9999
,11111,22222,33333,44444,55555,66666,77777,88888,99999
,111111,222222,333333,444444,555555,666666,777777,888888,999999
,1111111,2222222,3333333,4444444,5555555,6666666,7777777,8888888,9999999]
これらの中で、1桁の要素と、次の "11" の要素は除外する必要がある。表現が "11" となる数は基数 $B$ で値が $N = B + 1$ なので、基数の上限 $B < N-1$ にひっかかる。
1桁の要素 $N < B$ も同様である。結局、先頭B個を捨てる。あるいは、$B+1$以下のものを捨てる。
それよりも、zollo を2桁から開始して先頭を捨てる方がいい。
bnbb :: Integer -> [Integer] -- brazilian numbers of base b
-- 先頭B個を捨てる
bnbb b = genericDrop b $ zollo b
-- B+1以下を捨てる
bnbb b = dropWhile (succ b >=) $ zollo b
-- 2桁から開始する改編版zolloを内蔵したタイプ
bnbb b = tail [x | ru <- iterate (succ . (b *)) (succ b), x <- genericTake (pred b) [ru, ru + ru ..]]
さて、これをあらゆる B で生成したものを merge できればいいのだが、単純にやると無理。
merge :: Ord a => [a] -> [a] -> [a]
merge xxs@(x:xs) yys@(y:ys) =
case compare x y of
LT -> x : merge xs yys
EQ -> x : merge xs ys
GT -> y : merge xxs ys
merge [] ys = ys
merge xs [] = xs
brazilians_fail :: [Integer]
brazilians_fail = foldr merge [] $ map bnbb [2 ..]
人間なら b < c のとき head (bnbb b) < head (bnbb c) と直観的にわかっているが、merge はここより先は探しても無駄とかわからず、無限の大勢から最小の値を取り出してこようとして返ってこなくなる。
なのでそのような知識を持った上位レベルを置く。
左手にマージされて値を取り出すだけの列があり、右手にはマージを開始していない bnbb の列がある。
- 左手の先頭が右手の先頭の先頭より小さいとき、左手から一つ取り出す通常コースを進める。
- そうでないとき、右手の先頭を左手にマージする。
（パターンマッチの都合上、ロジックを逆にした）
brazilians :: [Integer]
brazilians = loop (bnbb 2) $ map bnbb [3 ..]
where
loop xs@(x:_) (ys@(y:_):yss) | x >= y = loop (merge xs ys) yss
loop (x:xs) yss = x : loop xs yss
タスクを実行する。
main :: IO ()
main = do
putStr "First 20 Brazilian numbers:"
print $ take 20 brazilians
putStr "First 20 odd Brazilian numbers:"
print $ take 20 $ filter odd brazilians
putStr "First 20 prime Brazilian numbers:"
print $ take 20 $ filter isPrime brazilians
First 20 Brazilian numbers:[7,8,10,12,13,14,15,16,18,20,21,22,24,26,27,28,30,31,32,33]
First 20 odd Brazilian numbers:[7,13,15,21,27,31,33,35,39,43,45,51,55,57,63,65,69,73,75,77]
First 20 prime Brazilian numbers:[7,13,31,43,73,127,157,211,241,307,421,463,601,757,1093,1123,1483,1723,2551,2801]
(3.40 secs, 478,611,056 bytes)
普通の generate & test アプローチ
Rosetta Code に示されているHaskellコードは、与えられた数がブラジリアン数かどうかを判定する述語を使う普通の考え方。しかしコードがちょっと普通じゃない。
isBrazil :: Int -> Bool
isBrazil n = 7 <= n && (even n || any (monoDigit n) [2 .. n - 2])
偶数がブラジリアン数なのはページに説明があった。なくても動くと思うけど。
基数 b で数 n がゾロ目かどうか判定する monoDigit n b がヤバい。
monoDigit :: Int -> Int -> Bool
monoDigit n b =
let (q, d) = quotRem n b
in d ==
snd
(until
(uncurry (flip ((||) . (d /=)) . (0 ==)))
((`quotRem` b) . fst)
(q, d))
最初に n を b で割った余りで、ゾロ目になるべき数字 d を取り出す。
until を使って前のステップの商をさらに b で割ることを続ける。
停止条件の式がもう全然読めないんだけど、商が0になるか、剰余がdでないかどちらかのとき。
停止したときに剰余がdなら、商が0で終わったということなのでゾロ目、と最後の判定をする。
自分の目にはどうにも読みにくいので、「普通」に直す。
monoDigit :: Int -> Int -> Bool
monoDigit n b = loop qr0
where
qr0@(_,d) = divMod n b
loop (q, r) = r == d && (q == 0 || loop (divMod q b))
あるいは除算の繰り返しよりゾロ目の数を作る乗算の方が楽だろうから、それを判定するやり方はどうだろう。
monoDigit n b = d /= 0 && n == m -- nが基数bでゾロ目なら
where
d = mod n b -- 基数bで割った余りは1の位の数字だからゾロ目の数字dなはず、それは0ではないはず
m:_ = dropWhile (n >) $ iterate ((d +) . (b *)) d -- n以上になる最初の基数bのdゾロ目を作る。それはnと等しくなるはず
どれも大して結果は違わなかった。
素数生成の時間が支配的ということか。
最終版
タスク1,2は、ブラジリアン数だけを順に生成する自分のアプローチが有利。
タスク3は、素数の方がまばらなので、それをtestするRosetta Codeのアプローチが有利。
自分の方の最終版として、ブラジリアン数は7以上で、偶数ならそれでよし、という知識を追加する。
loop の左手に最初に持たせるものを bnbb 2 でなく、8以上の偶数列にする。
brazilians :: [Integer]
brazilians = loop [8, 10 ..] $ map bnbb [2 ..]
where
...
今日はこのくらいで。