この記事は ひとりアドベントカレンダーRosettaCodeで楽しむプログラミング Advent Calendar 2025の13日めの記事です。
1から9までの数列をシャッフルされたものが示される。
左端からいくつかをまとめて逆転させるという操作だけができるので、いくつでやるかを指定する。
整列した状態まで持って行けたら完成。
という対話的なゲームをつくれというお題。
温故知新
アスキーの「Basic computer games : マイクロコンピュータゲーム集 日本語版」が自分の原風景の一部なのだけど（いまも本棚にちゃんとある）国立国会図書館デジタルコレクションで見られるようになっていた。懐かしくパラパラめくっていたら
https://dl.ndl.go.jp/pid/12631624/1/72 （アカウントを作成するとオンラインで閲覧できます）
なんと、まさにこのお題の回答が。
原著もarchive.orgにあった。
https://archive.org/details/basic-computer-games-microcomputer-edition_202207/page/135/mode/2up
挿絵のテイストがだいぶ違うな。
戦略
Haskell版ももうページにあるし、特にそれを作りたくはならない。
ゲームをプレイする側の視点で、戦略が気になる。
左端からしかひっくり返せないので、右奥、大きいものを先に奥に突っ込んでしまい、以後はそこは触らない、とする漸進的な方策が普通に考えられる。つまり、局面を見て：
- 全ての数字が正しい位置にあるなら完了
- 正しい位置に来ていない数字の中で、最大のものが
- 一番左にあるなら、その数字の大きさを指定する。すると、その数が正しい位置に納まる
- もっと右にあるなら、その数字の位置を指定する。すると、その数が左端に来る（ので次は上をやる）
を繰り返せばいつかは完成する。具体的には、2が正しい位置に来たときには1も正しい位置に来るので、2から9全ての数字に2手かかったとして16手あれば足りるだろう。
それは最適か？
もっと上手いことやると、少ない手数で整列させるやり方もありそうな気がする。が、具体的なアルゴリズムはわからない。
とりあえず、単位操作がこのやり方でのソートを pancake sort （ホットケーキソート？）というらしい。
Rosetta Code にもその項目は別にあるので、そっちでやるべきかもしれないが、そこは目をつむってもらって、今日は「数をひっくり返すゲーム」の最適戦略を考えよう。
調べ上げる
1からNまでの数の列を考える。
ソートされた状態から始めて、
- 2からNの数を指定してひっくり返すことで、N-1とおりの「手前」の状態ができる。
- これらの中で新規のものに、ソートされた状態からの距離を割り当てる。
という幅優先探索をすることで、全ての順列に対して、ソートされるまでの最小手数が得られる。
（この表があれば、手数が1小さくなる隣接局面に進むことを繰り返せば、手順も復元できる。）
Nは9以下と仮定して（場合の数の爆発も考えて、その程度でいいだろう。）
数字列は10進数として解釈したときの値で管理する。
import qualified Data.IntMap as IM
flipList :: [a] -> Int -> [a]
flipList xs k = reverse (take k xs) ++ drop k xs
-- makeMap n は、1からn≦9のpermutationをパンケーキソートするときの最短手数をもつIntMapを作る
makeMap :: Int -> IM.IntMap Int
makeMap n = go 1 (IM.singleton initial 0) [initial] []
where
go _nt im [] [] = im
go cnt im [] next = go (succ cnt) im next []
go cnt im (x:xs) next = go cnt im1 xs (ys ++ next)
where
s = show x
ys = [ y
| k <- [2 .. n]
, let y = read $ flipList s k
, IM.notMember y im ]
im1 = IM.union im $ IM.fromList [(y,cnt) | y <- ys]
initial = foldl (\acc d -> acc * 10 + d) 0 [1 .. n]
-- 一度作ってリストに入れておく
madeMaps = map makeMap [0 ..]
実行例。そのままだと見にくいので、距離で整列した。
ghci> makeMap 4
fromList
[(1234,0)
,(2134,1),(3214,1),(4321,1)
,(2314,2),(2341,2),(3124,2),(3421,2),(4123,2),(4312,2)
,(1243,3),(1324,3),(1342,3),(1423,3),(1432,3),(2143,3),(2431,3),(3241,3),(3412,3),(4132,3),(4213,3)
,(2413,4),(3142,4),(4231,4)
]
素朴な戦略を検証する
まず、素朴な戦略で、局面に対してどんな手を打つのかを求める。
入力は1からNの順列と仮定する。
takeUntil p (x:xs)
| p x = [x]
| otherwise = x : takeUntil p xs
takeUntil _ _ = []
trivialSeq :: [Int] -> [(Int,[Int])]
trivialSeq xs0 = takeUntil ((goal ==) . snd) $ iterate step (0, xs0)
where
n = length xs0
goal = [1 .. n]
step (_,xs) =
case maximum $ filter (uncurry (/=)) $ zip xs [1 ..] of
(d, 1) -> (d, flipList xs d)
(_, p) -> (p, flipList xs p)
ghci> trivialSeq [1,3,4,2,5]
[(0,[1,3,4,2,5]),(3,[4,3,1,2,5]),(4,[2,1,3,4,5]),(2,[1,2,3,4,5])]
madeMaps と突き合わせて、手数が異なるものを列挙する。
import Data.Char
testStrategy :: Int -> ([Int] -> [a]) -> [(Int,Int)]
testStrategy n sf = [(x, d) | (x,d) <- IM.assocs im, let len = length $ sf $ map digitToInt $ show x, succ d < len]
where
im = madeMaps !! n
ghci> testStrategy 2 trivialSeq
[]
ghci> testStrategy 3 trivialSeq
[]
ghci> testStrategy 4 trivialSeq
[(1243,3),(1432,3),(2431,3),(3241,3)]
ghci> testStrategy 5 trivialSeq
[(12354,3),(12435,3),(12543,3),(13542,4),(14253,5),(14325,3),(15324,5),(15342,5),(15423,4)
,(15432,3),(21354,4),(23154,4),(23541,3),(24153,5),(24315,3),(24351,5),(24531,4),(25341,4)
,(25413,4),(25431,3),(31524,5),(31542,5),(32415,3),(32451,3),(32514,4),(32541,4),(34251,4)
,(35124,4),(35142,5),(35412,4),(35421,3),(41253,4),(41352,5),(41523,4),(42351,4),(42513,5)
,(43152,4),(43251,3),(43512,4),(43521,3),(45231,4),(51342,4),(51423,4),(52341,4),(53421,4)]
ghci> length it
45
ghci> trivialSeq [1,2,3,5,4]
[(0,[1,2,3,5,4]),(4,[5,3,2,1,4]),(5,[4,1,2,3,5]),(4,[3,2,1,4,5]),(3,[1,2,3,4,5])]
例えば 1,2,3,5,4 は、下のようにすると3手で行ける。
1 2 3 5 4
---------+
4 5 3 2 1
---+
5 4 3 2 1
---------+
1 2 3 4 5
最適解
Rosetta Code/Sorting algorithms/Pancake sortの方では、対象が1から9の順列には制限されていない。
任意の整数列をパンケーキソートする実行例が色々と示されている。
それらについて、最適解を上と同様に逆算することで求めるプログラムにまとめることにしよう。
入力は整数のリストとする。実際には Eq と Ord があるものなら何でもよい。
結果は、最善な手順の一つとして、パンケーキソートのそれぞれの着手の幅とその結果のリストとする。
これで、実際にその手順でどうソートされるのかの経緯が観察できる
なお、最善な手順は唯一とは限らない。
makeMap と同様にして幅優先探索で距離マップを構築する。
ただし今回は、与えられた初期配置に到達したらそこで止める。それ以上は意味がないので。
その後、初期配置から、ゴールまでの距離を頼りに最善な手順の一つを復元する。
import qualified Data.Map as M
optimalstep :: (Eq a, Ord a) => [a] -> [(Int,[a])]
optimalstep xs = ans
where
n = length xs
final = sort xs
(cx, mZ) = bfs 1 (M.singleton final 0) [final] []
bfs _ _ [] [] = error "never happens"
bfs cnt m [] next
| elem xs next = (cnt, m)
| otherwise = bfs (succ cnt) m next []
bfs cnt m (ys:yss) next = bfs cnt m1 yss (zss ++ next)
where
zss = [zs | i <- [2 .. n], let zs = flipList ys i, M.notMember zs m]
m1 = M.unionWith min m $ M.fromList [(zs,cnt) | zs <- zss]
ans = post (pred cx) xs
post (-1) _ = []
post cy ys = izs : post (pred cy) zs
where
izs@(_,zs) = head [(i,zs) | i <- [2 .. n], let zs = flipList ys i, Just cy == M.lookup zs mZ]
ghci> optimalstep "helloworld"
[(2,"ehlloworld"),(9,"lrowollhed"),(5,"oworlllhed"),(4,"rowolllhed")
,(2,"orwolllhed"),(3,"wroolllhed"),(10,"dehllloorw")]
(3.49 secs, 836,092,880 bytes)
11lのところの例
ghci> optimalstep [6,7,2,1,8,9,5,3,4]
[(6,[9,8,1,2,7,6,5,3,4]),(9,[4,3,5,6,7,2,1,8,9]),(2,[3,4,5,6,7,2,1,8,9])
,(5,[7,6,5,4,3,2,1,8,9]),(7,[1,2,3,4,5,6,7,8,9])]
BASICのところの例
ghci> optimalstep [0,4,6,1,8,7,2,5,3,9]
[(3,[6,4,0,1,8,7,2,5,3,9]),(4,[1,0,4,6,8,7,2,5,3,9]),(6,[7,8,6,4,0,1,2,5,3,9])
,(2,[8,7,6,4,0,1,2,5,3,9]),(9,[3,5,2,1,0,4,6,7,8,9]),(2,[5,3,2,1,0,4,6,7,8,9])
,(6,[4,0,1,2,3,5,6,7,8,9]),(5,[3,2,1,0,4,5,6,7,8,9]),(4,[0,1,2,3,4,5,6,7,8,9])]
(119.79 secs, 21,256,448,472 bytes)
Dの例
ghci> optimalstep "769248135"
[(5,"429678135"),(8,"318769245"),(7,"296781345"),(5,"876921345"),(3,"678921345")
,(4,"987621345"),(9,"543126789"),(5,"213456789"),(2,"123456789")]
(10.96 secs, 3,244,083,208 bytes)
ルービックキューブと同じで、一つのマスにだけ注目してもどうにもならなくて、全体を見てうまいことやる、ができないと最適解は発見できない感じかな？
そして、二つあるJava解のうち、"Using Java 8" とある方は他と同様に素朴な戦略、しかしもう一方は、より効率的な戦略を実装しているようだ。なんだこれ！？
pediaを見る
14言語で項目になるくらい Pancake sorting はネタになるものなのね。
日本語版はない。
素朴な戦略による手数の上限は $2n-3$
反転回数の下限 $\frac{17}{16}n$ 上限 $\frac{5n+5}{3}$ を示した1979年の論文の著者の一人がビルゲイツ
上限は $\frac{18}{11}n$ と更新されたのは30年後
変な豆知識もあったものだ。
与えられた列に対して最短の手順を発見する問題はNP困難であることが2011年に証明された
ビルゲイツの論文には効率的なアルゴリズムも述べられている
なるほどJava版はこれを実装したのだろうか？
pediaからリンクされている元論文はスキャンが掠れているし、アルゴリズムAもそこで使っている用語も肝心の図2もいまいちわからないし、NotebookLMに突っ込んで説明させてみても煙に巻くことしかしてくれない。
仕方ないので Rosetta Code のJavaコードでも読むか…の前に、これもNotebookLMに突っ込んでみたら、これは素朴な戦略の改善版であってアルゴリズムAとは違う、とのたまう。そうなの？
public class PancakeSort
{
int[] heap;
public void flip(int n) { ... } // heapを前からn個反転して、画面に結果も表示する
public int[] minmax(int n) { ... } // heap[0,n) の最小値と最大値を探す、その位置を返す
public void sort(int n, int dir) { // dirは0か1 dirが0のとき、注目する値が最大か最小かが逆転する
if (n == 0) return;
int[] mM = minmax(n);
int bestXPos = mM[dir]; // 最大値の位置
int altXPos = mM[1-dir]; // 最小値の位置
boolean flipped = false;
if (bestXPos == n-1) { // 最大値がもう一番奥にあるなら、何もせずnを減らす
--n;
} else
if (bestXPos == 0) { // 最大値が先頭にあるなら、それを一番奥に押し込んでnを減らす
flip(n-1);
--n;
} else
if (altXPos == n-1) { // 最小値が一番奥にあるなら
dir = 1-dir; // 向きを逆にして
--n; // nを減らして
flipped = true; // 逆転モード中フラグを立てる
}
else {
flip(bestXPos); // どれでもなければ、最大値を一番手前に持ってくる
}
sort(n, dir); // この再帰呼び出しは whileループじゃいかんのかな。flippedフラグだけ、nごとに必要な感じ。
if (flipped) { // 逆転モードで考えていたなら、最後にひっくり返し戻す
flip(n);
}
}
PancakeSort(int[] numbers) { // heapを与えられた列で初期化してソートを実行
heap = numbers;
sort(numbers.length, 1);
}
public static void main(String[] args) { ... } // コマンドライン引数から列を受けて PancakeSort のインスタンスを実行
}
なるほどこれは、素朴な戦略に、「一時的に逆転で考える」というモードを追加して効率を向上させる変種だ。
この戦略の効率、最適戦略との差を測定しよう。
まずアルゴリズムを移植する。
import Data.Bool
import Data.Tuple
javaSeq :: (Eq a, Ord a) => [a] -> [(Int,[a])]
javaSeq xs0 = reverse $ recur [(0,xs0)] xs0 (length xs0) True
where
recur res _ 1 _ = res
recur res xs n dir
| bestPos == pred n = recur res xs (pred n) dir
| bestPos == 0 = recur ((n, xsN) : res) xsN (pred n) dir
| altPos == pred n = (n, flipList xs1 n) : res1
| otherwise = recur ((succ bestPos, xsM) : res) xsM n dir
where
nxs = take n xs
Just iM = elemIndex (maximum nxs) xs
Just im = elemIndex (minimum nxs) xs
(bestPos, altPos) = bool swap id dir (iM, im)
xsN = flipList xs n
xsM = flipList xs (succ bestPos)
res1 = recur res xs (pred n) (not dir)
xs1 = snd $ head res1
ghci> javaSeq [1,2,5,4,3,10,9,8,7]
[(0,[1,2,5,4,3,10,9,8,7]),(6,[10,3,4,5,2,1,9,8,7]),(9,[7,8,9,1,2,5,4,3,10])
,(3,[9,8,7,1,2,5,4,3,10]),(8,[3,4,5,2,1,7,8,9,10]),(3,[5,4,3,2,1,7,8,9,10])
,(5,[1,2,3,4,5,7,8,9,10])]
ghci> javaSeq [6,7,2,1,8,9,5,3,4]
[(0,[6,7,2,1,8,9,5,3,4]),(6,[9,8,1,2,7,6,5,3,4]),(9,[4,3,5,6,7,2,1,8,9])
,(2,[3,4,5,6,7,2,1,8,9]),(5,[7,6,5,4,3,2,1,8,9]),(7,[1,2,3,4,5,6,7,8,9])]
完全に一致。
検証する。
checkJavaStrategy :: Int -> [Int]
checkJavaStrategy n = [x | (x,d) <- IM.assocs im, length (javaStrategy $ show x) /= d]
where
im = makeMap n
initial = foldl (\acc d -> acc * 10 + d) 0 [1 .. n]
ghci> testStrategy 2 javaSeq
[]
ghci> testStrategy 3 javaSeq
[]
ghci> testStrategy 4 javaSeq
[(1243,3),(1432,3)]
ghci> testStrategy 5 javaSeq
[(12354,3),(12435,3),(12543,3),(13542,4),(14253,5)
,(14325,3),(15324,5),(15423,4),(15432,3),(21354,4)
,(23154,4),(25413,4),(31524,5),(32514,4),(35124,4)
,(35142,5),(35412,4),(41253,4),(41352,5),(41523,4)
,(42513,5),(43152,4),(43512,4),(52341,4),(53421,4)]
ghci> length it
25
素の素朴戦略よりは改善はされている。
計測
余計に必要とするステップ数の総和も数えてみよう。
testStrategy1 :: ([Int] -> [a]) -> Int -> (Int, Int)
testStrategy1 sf n = (length ds, sum ds)
where
im = madeMaps !! n
ds = [len - succ d | (x,d) <- IM.assocs im, let len = length $ sf $ map digitToInt $ show x, succ d < len]
ghci> map (testStrategy1 trivialSeq) [2 .. 9]
[(0,0),(0,0),(4,6),(45,73),(423,773),(3771,8116),(34587,88977),(335658,1034045)]
ghci> map (testStrategy1 javaSeq) [2 .. 9]
[(0,0),(0,0),(2,2),(25,29),(278,377),(2847,4540),(28924,54765),(301170,681653)]
このままでは消化不良なので、次回に続きます。