順列の前後（辞書順）
$ (1,\dots,N)の順列$ P=(P_1,\dots,P_N)が与えられます。ただし、$ (P_1,\dots,P_N)\ne(1,\dots,N)です。
$ (1,\dots,N)の順列を全て辞書順で小さい順に並べたとき、$ Pが$ K番目であるとします。辞書順で小さい方から$ K-1番目の順列を求めてください。
与えられた$ Pから$ Kを求めて、$ K-1番目の順列を構成するという方法も考えられる。その場合、$ Kが最悪$ N!になる。
（この問題では$ 2\le N \le 100という制約があるので、任意長整数が扱えればなんとかなる。）
順列に付番することなく、直前の順列を求めたい。すこし、一般化して考えよう。
辞書順の先頭の順列$ a_0\cdot a_1\cdots a_{n-1}\cdot a_nでは、$ a_0 < a_1 < \cdots < a_{n-1} < a_nがなりたつ。先頭であるから、これより「前」はない。「前」があるのは、この関係連鎖のなかに$ >がある場合である。
そこで、$ a_i > a_{i+1}かつ$ a_{i+1}以降すべて$ <の関係が成り立つとする。
$ a_i > a_{i+1} < \cdots < a_n
そうすると、順列$ a_{i+1}\cdots a_nは、この$ n-i個の要素からなる順列で辞書順の先頭になる。ということは、ここの部分の並び換えだけでは全体順列の「前」を構成できない。
$ a_{i+1}\cdots a_nの中で$ a_i未満で最大の要素を$ a_j(i < j)とすると、$ a_iと$ a_jとを交換して、$ i+1番目以降を降順で整列して新しい部分列（新しい構成要素でできる順列の辞書順で最後の順列）を構成すればよい。
$ a_0\cdots a_{i-1}\cdot a_i\cdot a_{i+1}\cdots a_j\cdots a_n\;\longrightarrow\; a_0\cdots a_{i-1}a_j\cdot\mathit{sort_{>}}(a_{i+1}\cdots a_i\cdots a_n)
以下の手順で構成する
1. 当該の順列を右から順にみて、最初に$ >が出現したところを探索する。
2. 最初に$ >が出現した位置の直ぐ左側（$ >の左オペランド）を$ a_iとする。($ a_0 \cdots a_i > a_{i+1} < \cdots < a_n)
3. $ a_iと、繰下げ位置のすぐ右側（$ >の右オペランド）$ a_{i+1}以降で$ a_i未満で最大のものとを入れ換える。
4. $ i+1番目以降を降順に整列する。
5. 最初から交換済$ i番目までと、交換、整列済みの$ i+1番目以降を連結
コードは以下のとおり。ただし、降順ソートしてから入れ換えている。3.と4.の2つの手順は、入れ換えても結果は同じになる。
code:haskell
prevPerm :: Ord a => a -> a prevPerm xs = case pqs of
(ps,qs@(q0:_:_)):_ -> ps ++ head qs1 : (qs0 ++ tail qs1)
where
(qs0,qs1) = span (q0 <=) (sortOn Down qs)
_ -> []
where
pqs = dropWhile phi $ reverse $ zip (inits xs) (tails xs)
phi = \ case
(_,z0:z1:_) -> z0 < z1
_ -> True
{-
3 5 2 6 4 1
~~~↑~~~ ↑ ~~~↑~~~ ~↑~
ps ++ head qs1 : (qs0 ++ tail qs1)
-}
直後の順列を構成するには、直前の順列を構成するときに使った比較演算を反転すればよい。すなわち、
$ >を$ <に、$ <を$ >に置き換えて考えればよい（整列も「降順」を「昇順」に置き換える）。
code:haskell
nextPerm :: Ord a => a -> a nextPerm xs = case pqs of
(ps,qs@(q0:_:_)):_ -> ps ++ head qs1 : (qs0 ++ tail qs1)
where
(qs0,qs1) = span (q0 >=) (sort qs)
_ -> []
where
pqs = dropWhile p $ reverse $ zip (inits xs) (tails xs)
p = \ case
(_,z0:z1:_) -> z0 > z1
_ -> True
比較を反転するかどうかの違いなので、これをパラメータ化できる。
N.B. モジュール宣言の前に言語拡張プラグマ{-# LANGUAGE ImplicitParams #-}を置く必要がある。
code:haskell
stepPerm :: (Ord a, ?flipFlag :: Bool)
stepPerm xs = case pqs of
(ps,qs@(q0:_:_)):_ -> ps ++ head qs1 : (qs0 ++ tail qs1)
where
(qs0,qs1) = span (?opflip (>=) q0) (sortBy (?opflip compare) qs)
_ -> []
where
pqs = dropWhile p $ reverse $ zip (inits xs) (tails xs)
p = \ case
(_,z0:z1:_) -> fliping (>) z0 z1
_ -> True
fliping | ?flipFlag = flip
| otherwise = id
prevPerm :: Ord a => a -> a prevPerm = let ?flipFlag = True in stepPerm
nextPerm :: Ord a => a -> a nextPerm = let ?flipFlag = False in stepPerm