Haskellプログラミング：直前の順列（ABC 276 C）
はじめに
これは、Haskell Advent Calendar 2025 の第１日目の記事です。
小さなプログラム断片を書く楽しみを共有したいと考えながら書いています。
筆者は、Haskellプログラミングが好きな「アマ」グラマーです。もっぱら、プログラミングを楽しむためだけにプログラミングしています。最近は、AtCoder Beginners Contest の問題を解くプログラミングを楽しんでいます。AtCoder NoviStepsという素敵なサイトがあって、そこではグレード別に過去問題を分類してあったり、解法別に分類してくれています。
直前の順列
AtCoder Beginer Contest 276 の C 問題に Previous Permutation（直前の順列）という問題がありました。おもしろそうなので取り組んでみましょう。
この問題は、NoviStepsでは4Qに分類されている問題です。このグレードがどのくらいのものなのかは、概要がグレードの目安にあり、更に詳しくはそのページにあるリンク先を参照してください。
それはさておき、問題文を引用しましょう。
問題文
の順列 (1,\dots,N) が与えられます。ただし、 P=(P_1,\dots,P_N) です。 (P_1,\cdots,P_N)\ne(1,\dots,N)
の順列を全て辞書順で小さい順に並べたとき、 (1,\dots,N) が P 番目であるとします。辞書順で小さい方から K 番目の順列を求めてください。 K-1
アイデア１
まず、思いついたのは、
与えられた
から P をもとめて、 K 番目の順列を構成する。 K-1
です。
これは、順列のエンコードとデコードという興味深い課題になります。しかし、Integerを使えばなんとかなりそうではあります）。
アイデア２
順列のエンコード、デコードをおこなわずに直接計算することを考えましょう。アイデアとしては以下の通りです。
- 辞書順の先頭の順列
では、 a_1\cdot a_2\cdots a_{n-1}\cdot a_n がなりたつ。先頭であるから、これより「前」はない。「前」があるのは、この関係連鎖のなかに a_1 < a_2 < \cdots < a_{n-1} < a_n がある場合である。 > かつ a_i > a_{i+1} 以降すべて a_{i+1} の関係が成り立つ、すなわち、 < であるとすると、 a_i > a_{i+1} < \cdots < a_n 番目以降の順列はそれらの要素で構成される順列のうち最小のものであるので、 i+1 番目以前の部分を固定して、 i 番目以降だけを並び換えても「前」は構成できない。 i+1 のなかで a_{i+1}\cdots a_n 未満で最大のものと a_i を交換して、 a_i 番目以降を降順で整列する。このとき整列した列は i+1 番目以降の要素で構成した順列のうち最大のものになる。 i+1
プログラムの構成方針は、
- 順列
a_1\cdots a_n a_i > a_{i+1} < \cdots < a_n (a_1\cdots a_{i-1}\;,\;a_i\cdot a_{i+1}\cdots a_n) -
a_{i+1}\cdots a_n a'_{i+1}\cdots a'_n -
a'_{i+i}\cdots a'_n a'_{j-1} > a_i > a'_j (a'_{i+1}\cdots a'_{j-1}\;,\;a'_j\cdot a'_{j+1}\cdots a'_n) -
a_1\cdots a_{i-1}\cdot a'_j\cdot a'_{i+1}\cdots a'_{j-1}\cdot a_i\cdot a'_{j+1}\cdots a'_n
です。
prevPerm
prevPerm :: Ord a => [a] -> [a]
prevPerm as = case psqs of
(ps,qs@(q0:_:_)) -> ps ++ head q's1 : (q's0 ++ tail q's1)
where
(q's0, q's1) = span (q0 <=) (sortOn Down qs)
_ -> []
where
psqs = dropWhile phi $ reverse $ zip (inits as) (tails as)
phi = \ case
(_,r:s:_) -> r < s
_ -> True
直後の順列
「直前の順列」prevPermを定義したので、ついでに「直後の順列」nextPermも定義しましょう。基本のアイデアは同じ構造で、比較演算を反転すればよいでしょう。
nextPerm
nextPerm :: Ord a => [a] -> [a]
nextPerm as = case psqs of
(ps,qs@(q0:_:_)) -> ps ++ head q's1 : (q's0 ++ tail q's1)
where
(q's0, q's1) = span (q0 >=) (sort qs)
-- ----
_ -> []
where
psqs = dropWhile phi $ reverse $ zip (inits as) (tails as)
phi = \ case
(_,r:s:_) -> r > s
---
_ -> True
prevPerm を使った nextPerm
比較演算を反転するかわりに、順列要素を大小関係で反転してもよいので以下のようにも定義できますね。
nextPerm :: Ord a => [a] -> [a]
nextPerm = convert . prevPerm . convert
where
convert xs = map (table Data.Map.!) xs
where
table = Data.Map.fromList $ zip <*> reverse $ sort xs
直「前後」の順列
「前」「後」をパラメータ化することもできます。「前」「後」を「反転する」「反転しない」におきかえれば両方に対応するコードを１つにできます。
stepPerm :: Ord a => Bool -> [a] -> [a]
stepPerm flag as = case psqs of
(ps,qs@(q0:_:_)) -> ps ++ head q's1 : (q's0 ++ tail q's1)
where
(q's0, q's1) = span (fliping (>=) q0) (sortBy (fliping compare) qs)
------------ ------------------------
_ -> []
where
psqs = dropWhile phi $ reverse $ zip (inits as) (tails as)
phi = \ case
(_,r:s:_) -> fliping (>) r s
-----------
_ -> True
fliping | flag = flip
| otherwise = id
prevPerm :: Ord a => [a] -> [a]
prevPerm = stepPerm True
nextPerm :: Ord a => [a] -> [a]
nextPerm = stepPerm False
Discussion