この記事は ひとりアドベントカレンダーRosettaCodeで楽しむプログラミング Advent Calendar 2025の12日めの記事です。
タスク
その数を構成する全ての数字が互いに異なり、またそれらで割り切れるような最大の数を求めよ。
- 10進数で。
- (stretch goal) 16進数で。
ヒント：全ての数字で割れる必要があるので、0は含まれることがない。なので最大で基数ー1桁の数になる。
汎用的な解（自作版）
任意の基数 $b$ に対応するアルゴリズムを考える。
最大値を探すので、まず $k = b-1$ 桁、次に $b-2$ 桁、…と桁数を徐々に下げて探していく。
これらの数の最小公倍数の倍数を順に調べるか、数字の順列組み合わせを調べるか、後者の方が圧倒的に密度が低いと予想した。
数字 1 から $b-1$ の中から $k$ 個を重なりなく選んで並べる $_{b-1}P_k$ とおりのやり方を、
数が大きいものから順に生成する。
生成された数を全ての数字で割ってみて、全て割り切れるならそれが答えである。
import Data.Bits
-- for test
import Data.Char
import Numeric
import Text.Printf
solve :: Int -> IO ()
solve base = printf "%d %s\n" ans (showIntAtBase base intToDigit ans "")
where
digits = reverse [1 .. pred base]
ans = head [x | k <- digits, x <- nPk k]
nPk k0 = iter 0 0 k0
where
iter :: Int -> Int -> Int -> [Int]
iter used x 0 = [x | and [mod x i == 0 | i <- digits, testBit used i]]
iter used x k =
[ y
| let x1 = x * base, i <- digits, not $ testBit used i
, y <- iter (setBit used i) (x1 + i) (pred k) ]
ghci> mapM_ solve [2 .. 9]
1 1
2 2
54 312
108 413
152 412
16200 65142
2042460 7625134
4416720 8271536
(0.26 secs, 146,113,872 bytes)
ghci> solve1 10
9867312 9867312
(3.75 secs, 2,157,692,168 bytes)
ghci> solve1 11
2334364200 a98762413
(23.94 secs, 13,356,165,792 bytes)
ghci> solve1 16
1147797065081426760 fedcb59726a1348
(17.24 secs, 9,064,434,432 bytes)
ページにある速い解法にはまるで追いつけない。
特化解
Rakuの項目で分析がされている。
論理の飛躍や誤りを補足して引き写す。
10進の場合
- 数字に0は現れない（既出）
- 数字に5が現れるとすると、10進数で5の倍数の1の位は0か5だけなので、1の位になる。
すると奇数なので偶数の数字2,4,6,8は使えなくなる。
このとき、9,7,3,1の順列に5を続けた5桁の数だけが作れる。
ところで、数字の和は3,9の倍数を見分ける手段として使えるので、$9+7+3+1+5=25$ は3の倍数でない。
1を除くと24になるがこれは9の倍数でない、5を除いた20は3の倍数でない、1を除いた24も9の倍数でない。
なので9も使えないことが判明する。すると、さらに1を除いた 7,3,5 または 7 を除いた 3,1,5 だけが使える数字として残る。
これは余りにも小さいので、他にどうしようもなかったときに戻ってくる場所として覚えておき、以降、数字5は使わない作り方だけを考える。 - 5を使わない場合は 9,8,7,6,4,3,2,1 が使える数字として残る。
これらの数字の和は 40 であり、3の倍数でないので、3,6,9が含まれていることと矛盾する。
つまり、これらの数字を全て使うことは諦めるしかない。 - 3の倍数であることを諦めると、3,6,9の3つの数字が消えて5桁以下になる。
いずれか1つの数字を抜いて3の倍数にしようとすると、1,7では3の倍数であるが9の倍数でないのが矛盾。
4だと9の倍数になり、9,8,7,6,3,2,1 を並べた7桁の数、を最初に候補として探してみるのが適切と考えられる。
それでだめなら、またここから考え直す。 - これらの数字の最小公倍数 504 の倍数だけを考えればよい。
（これはHaskell版コードから。）
という検討から、使える数字で作れる最大の数 9876321 以下の 504 の倍数を大きい順に調べ、
数字がちょうどそれらである最初の数を答えとして返す。
のかと思ったら、Rakuのコードでは
「数字に0,5が含まれず、数字の重複がないもの」だけを条件としている。
4が入ってきたらどうするつもりだったのか、これは偶々正しい答えと同じ出力をするだけの、間違ったプログラムといえないか？
探索の上限が 9876432 で大きすぎるのも、まぁ安全サイドに振っただけかもしらんけど不正確。
やってみる。
-- Raku base10 の考察を使ったコード
rakuBase10 :: Int
rakuBase10 = head [x | x <- [ub, ub - magic .. 1236789], mask == sum [bit i | i <- enDigitsBase 10 x]]
where
digits = [1,2,3,6,7,8,9]
magic = foldr lcm 1 digits
ub = magic * div 9876321 magic
mask = sum [bit i | i <- digits] :: Int
enDigitsBase :: Integral t => t -> t -> [t]
enDigitsBase _ 0 = []
enDigitsBase b x = let (q,r) = divMod x b in r : enDigitsBase b q
ghci> rakuBase10
9867312
(0.02 secs, 188,264 bytes)
汎用版との差に愕然。が、分析の途中に書いてある
Practically though, the code to accommodate these observations is longer running and more complex than just brute-forcing it from here.
でクスっとしたので許す。
ページのHaskell版では、1,4,7のいずれかを除外した3通りの数字7個のセットについて、permutations で順列組み合わせを作って、1,2,3,4,6,7,8,9 全てで（その最小公倍数で）割れるような数を全て集めて、その最大値、とやっている。
分析の使い方が中途半端だし、7を除くときに504の倍数かを調べるのは不適切。
4を除くときにもlcmを計算し直すべきだが、どうせ8が入っているので無意味だけど。
ということで、最大値は幸い正しいものになったが「7桁のそういう数を全て出せ」などに拡張しようとすると露わになるバグを抱えたプログラムだ。
Data.List.permutations はよくわからない並び順で出すので、与えたリストの順を大小関係として辞書順に出すようなコードを自作して、最初に見つかったものが正解、とする方が、全て出して最大値、より速いだろう。
hasBase10 :: Int
hasBase10 = head
[x | ds <- perms $ reverse digits, let x = deDigitsBase 10 ds, mod x magic == 0]
where
digits = [1,2,3,6,7,8,9]
magic = foldr lcm 1 digits
deDigitsBase :: Integral t => t -> [t] -> t
deDigitsBase b ds = foldl' (\acc d -> acc * b + d) 0 ds
perms :: (Eq a) => [a] -> [[a]]
perms [] = [[]]
perms xs = [x:xr | x <- xs, xr <- perms $ delete x xs]
ghci> hasBase10
9867312
(0.01 secs, 161,536 bytes)
16進の場合
こちらでは10進のようなめざましい分析はできず、とりあえず全ての数字を使う15桁の数について、
公倍数の倍数を大きい順に探すやり方をとっている。
上の rakuBase10 からかなりそのまま作成できるが、一点だけ、汎用性を狙って作った enDigitsBase が足を引っ張るので、 Numeric.showHex に置き換えることで速度が稼げる。
hasBase16 :: Int
hasBase16 = head [x | x <- [ub, ub - magic .. 0x123456789abcdef], noDup $ '0' : showHex x ""]
where
digits = [1 .. 15]
magic = foldr lcm 1 digits
ub = magic * div 0xfedcba987654321 magic
noDup "" = True
noDup (x:xs) = notElem x xs && noDup xs
ghci> hasBase16
1147797065081426760
(1.59 secs, 3,121,542,344 bytes)