これは何?
上記アドベントカレンダーの7日目の記事です。
背景: 純粋性を失わずにソートの途中経過がほしい
上記の問題で挿入ソートを実装することを求められた。
普通にHaskellで挿入ソートを実装すると以下のようなコードになる。
insertSort :: (Ord a) => [a] -> [a]
insertSort xs = foldl (flip insert) [] xs -- flipは関数につけて引数の順序を逆にする
where
insert x [] = [x]
insert x (y : ys) -- xをyとysの間に入れられるか調べる
| x <= y = x : y : ys -- yの前にxを入れる
| otherwise = y : insert x ys -- yとysの間にxは入れられることがわかったので、再帰してxを入れる適切な位置を探す。
main :: IO ()
main = interact $ \inputs ->
let ls = lines inputs
xs = map (read :: String -> Int) . words $ ls !! 1
in (unwords . map show $ insertSort xs) ++ "\n"
しかし、問題の特性上1ステップごとにソートの過程を出力する必要がある。
# 現状の出力例
1 2 3 4 5 6
# 問題文の求める出力例
5 2 4 6 1 3
5 2 4 6 1 3
2 5 4 6 1 3
2 4 5 6 1 3
2 4 5 6 1 3
1 2 4 5 6 3
1 2 3 4 5 6
Immutableな状態では慣れが必要
見も蓋も無いことを言うと、純粋性を捨てればすぐに解決できる。
def insertion_sort(A):
N = len(A)
print(*A) # 初期状態
for i in range(1, N):
v = A[i]
j = i - 1
while j >= 0 and A[j] > v:
A[j + 1] = A[j]
j -= 1
A[j + 1] = v
print(*A)
if __name__ == "__main__":
N = int(input())
A = list(map(int, input().split()))
insertion_sort(A)
上記の例の場合挿入ソートをしながら、内部でprintを呼び出せばよい。
しかし、Haskell版では以下の制約がある。
- Haskellの変数がImmutableであるため、元のリストを更新できないこと
-
forの変わりに再帰で実装しており、空のリスト
に値を放り込みながらsortしている。
-
- (できなくはないが)
insertSort関数を純粋関数にしておきたいため、副作用であるprintなどの出力をしたくない。
無邪気にfoldlをscanlに書き換えてみる(これだけでは上手く行かない例)
foldlは途中経過を保持せず、畳み込み(reduce)の結果のみを保持している。
そこで、途中経過を保持するscanlに書き換えてみる。
ghci> foldl (+) 0 [1..10]
55
scanl (+) 0 [1..10]
[0,1,3,6,10,15,21,28,36,45,55]
-- ACできないが途中過程を見えるようにしたもの
insertSort :: (Ord a) => [a] -> [[a]]
insertSort xs = scanl (flip insert) [] xs -- foldlをscanlに書き換えた
where
insert x [] = [x]
insert x (y : ys) -- xをyとysの間に入れられるか調べる
| x <= y = x : y : ys -- yの前にxを入れる
| otherwise = y : insert x ys -- yとysの間にxは入れられることがわかったので、再帰してxを入れる適切な位置を探す。
main :: IO ()
main = interact $ \inputs ->
let ls = lines inputs
xs = map (read :: String -> Int) . words $ ls !! 1
in unlines $ map (unwords . map show) $ insertSort xs
5
2 5
2 4 5
2 4 5 6
1 2 4 5 6
1 2 3 4 5 6
途中経過は出るようになったものの、挿入ソートは空のリストに要素を追加する過程でソートするため、scanlが保持しているデータは全体ではない。
ソート結果と途中結果を分けて持つ(解決策1)
scanlに渡す初期値を`(現状のソート済みの部分, 途中結果)に分けてもつことで実現できる。
insertSort :: (Ord a) => [a] -> [[a]]
insertSort xs =
let steps = scanl step ([], xs) [1 .. length xs]
in tail $ map (\(sorted, rest) -> sorted ++ rest) steps -- NOTE: scanlは初期値を出力するのでtailで捨てている。
where
step (sorted, r : rs) _ = (insert r sorted, rs) -- 連結するためにタプルでrsも持つ
insert x [] = [x]
insert x (y : ys)
| x <= y = x : y : ys
| otherwise = y : insert x ys
main :: IO ()
main = interact $ \inputs ->
let ls = lines inputs
xs = map (read :: String -> Int) . words $ ls !! 1
in unlines $ map (unwords . map show) $ insertSort xs
5 2 4 6 1 3
2 5 4 6 1 3
2 4 5 6 1 3
2 4 5 6 1 3
1 2 4 5 6 3
1 2 3 4 5 6
これでめでたく問題には回答できた。
しかし、steps = scanl step ([], xs) [1 .. length xs]の部分で、せっかく畳み込みを使っているのに挿入ソートのリストサイズで配列を作り、ループを回しているなど、気に入らない点があり、美しくないと感じる。
mapAccumLを使ってよりエレガントに
mapAccumLは、畳み込みを行いながら、その途中経過についても並べて返すことが出来る関数である。
以下のような畳込みの途中経過を保存するだけであれば、scanlなどで事足りることが多い。
main :: IO ()
main = do
-- mapAccumLを使わなくてもscanlで同じようなことができる例
print $ scanl (+) 0 [1 .. 10] -- [0,1,3,6,10,15,21,28,36,45,55]
print $ mapAccumL (\acc x -> (acc + x, acc)) 0 [1 .. 10] -- (55,[0,1,3,6,10,15,21,28,36,45])
import Data.List (mapAccumL)
しかし、畳み込みをしつつ、途中経過の部分で何でも返すことができるのがmapAccumLの強みである。
main :: IO ()
main = do
-- 状態は合計を出すが、出力は2倍したものを並べるみたいなことはmapAccumLを使わないとできない
print $ mapAccumL (\acc x -> (acc + x, x * 2)) 0 [1 .. 10] -- (55,[2,4,6,8,10,12,14,16,18,20]) x * 2が結果としてリストに保持される
これを使用した例が以下。
import Data.List (mapAccumL)
-- ソート中の状態を配列すべてにおいて見えるようにしたもの(mapAccumLを使用)
insertSort :: (Ord a) => [a] -> [[a]]
insertSort xs = snd $ mapAccumL step ([], xs) xs -- mapAccumL step (ソート済みの領域の初期値, 未ソート領域の初期値) xs
where
step (sorted, _ : rest) x =
let sorted' = insert x sorted
row = sorted' ++ rest -- 途中の状態をすべて出力するために、ソート済みと未ソート領域を足したものを用意している。
in ((sorted', rest), row) -- rowはmapAccumLに保存されるだけで畳み込みには使用されない。
insert x [] = [x]
insert x (y : ys)
| x <= y = x : y : ys
| otherwise = y : insert x ys
main :: IO ()
main = interact $ \inputs ->
let ls = lines inputs
xs = map (read :: String -> Int) . words $ ls !! 1
in unlines $ map (unwords . map show) $ insertSort xs
個人的には畳み込みがきちんと使われているし、処理も追いやすくなったと思う。