バブルソートは隣接した値を交換することでソートするアルゴリズムです。これをHaskellで実装してみます。
以下の練習問題の補足説明を兼ねています。
アルゴリズム
右から2つずつ比較して、左が小さくなるように交換します。比較対象を()
で囲んで示します。
-
[ 4 , 3 , 1 ,(5),(2)]
→ 交換 -
[ 4 , 3 ,(1),(2), 5 ]
→ 何もしない -
[ 4 ,(3),(1), 2 , 5 ]
→ 交換 -
[(4),(1), 3 , 2 , 5 ]
→ 交換 -
[(1), 4 , 3 , 2 , 5 ]
→ 左端が最小値となる
この様子を縦に並べると、小さい数が上に移動している様子が分かります。この小さい数を「泡」に見立てたのがバブルソートの名前の由来です。
- | 2. | 3. | 4. | 5.
-----|-----|-----|-----|-----
4 | 4 | 4 | 4 |1
3 | 3 | 3 |1| 4
1 | 1 |1| 3 | 3
5 |2| 2 | 2 | 2
2| 5 | 5 | 5 | 5
左端まで来た最小値を除いて、再度交換を行います。これを繰り返すことでソートできます。
-
1 : [ 4 , 3 ,(2),(5)]
→ 何もしない -
1 : [ 4 ,(3),(2), 5 ]
→ 交換 -
1 : [(4),(2), 3 , 5 ]
→ 交換 -
1 : [(2), 4 , 3 , 5 ]
→ 左端の最小値を分離 -
1 : 2 : [ 4 ,(3),(5)]
→ 何もしない -
1 : 2 : [(4),(3), 5 ]
→ 交換 -
1 : 2 : [(3), 4 , 5 ]
→ 左端の最小値を分離 -
1 : 2 : 3 : [(4),(5)]
→ 何もしない -
1 : 2 : 3 : [(4), 5 ]
→ 左端の最小値を分離 -
1 : 2 : 3 : 4 : [ 5 ]
→ ソート完了
実装
Haskellで実装してみます。
右へ移動(往路)
まず交換する関数を実装します。
再帰でリストを処理するときに左から見ていく都合上、最小値を右端に移動させます。
bswap [x] = [x]
bswap (x:y:zs)
| x < y = y : bswap (x:zs)
| otherwise = x : bswap (y:zs)
main = do
print $ bswap [4, 3, 1, 5, 2]
[4,3,5,2,1]
ここから右端とそれ以外を分離する必要があります。いくつか方法を示します。
bswap [x] = [x]
bswap (x:y:zs)
| x < y = y : bswap (x:zs)
| otherwise = x : bswap (y:zs)
main = do
let a = bswap [4, 3, 1, 5, 2]
print a
let (x:xs) = reverse a
print (x, xs)
let i = length a - 1
x = a !! i
xs = take i a
print (x, xs)
let x = last a
xs = init a
print (x, xs)
[4,3,5,2,1]
(1,[2,5,3,4])
(1,[4,3,5,2])
(1,[4,3,5,2])
本体
bswap
の結果を分離して再帰すれば完成です。上で示した各種分離方法を使ったものを示します。
bsort1 [] = []
bsort1 xs = y : bsort1 ys
where
(y:ys) = reverse $ bswap xs
bsort2 [] = []
bsort2 xs = y : bsort2 ys
where
a = bswap xs
i = length a - 1
y = a !! i
ys = take i a
bsort3 [] = []
bsort3 xs = y : bsort3 ys
where
a = bswap xs
y = last a
ys = init a
main = do
print $ bsort1 [4, 3, 1, 5, 2]
print $ bsort2 [4, 3, 1, 5, 2]
print $ bsort3 [4, 3, 1, 5, 2]
[1,2,3,4,5]
[1,2,3,4,5]
[1,2,3,4,5]
左へ移動(復路)
復路で交換すれば左端に移動することが可能です。
再帰前に処理していたものを再帰後に処理するように変更します。
bswap [x] = [x]
bswap (x:xs)
| x > y = y:x:ys
| otherwise = x:y:ys
where
(y:ys) = bswap xs
main = do
let a = bswap [4, 3, 1, 5, 2]
print a
let (x:xs) = a
print (x, xs)
[1,4,3,2,5]
(1,[4,3,2,5])
※ このテクニックで後ろから処理できるアルゴリズムは限られています。汎用的に逆転できるわけではありません。
本体
bswap
の結果から左端を分離して再帰すれば完成です。
bsort [] = []
bsort xs = y : bsort ys
where
(y:ys) = bswap xs
main = do
print $ bsort [4, 3, 1, 5, 2]
[1,2,3,4,5]
まとめ
- ソート本体を実装する前に、交換する関数を作り込む。
- いきなり復路で実装しようとすると混乱するので、まず往路で実装して変形する。
bswap [x] = [x]
bswap (x:xs)
| x > y = y:x:ys
| otherwise = x:y:ys
where
(y:ys) = bswap xs
bsort [] = []
bsort xs = y : bsort ys
where
(y:ys) = bswap xs
main = do
print $ bswap [4, 3, 1, 5, 2]
print $ bsort [4, 3, 1, 5, 2]
print $ bsort [5, 4, 3, 2, 1]
print $ bsort [4, 6, 9, 8, 3, 5, 1, 7, 2]
[1,4,3,2,5]
[1,2,3,4,5]
[1,2,3,4,5]
[1,2,3,4,5,6,7,8,9]
注意
以下のように一関数で実装すると一見動いているように見えます。しかし計算量が爆発します。
bsort [] = []
bsort [x] = [x]
bsort (x:xs)
| x < y = x : bsort (y:ys)
| otherwise = y : bsort (x:ys)
where
(y:ys) = bsort xs
main = do
print $ bsort [4, 3, 1, 5, 2]
[1,2,3,4,5]
大き目のリストでソートしたり、trace
で過程を表示すると、無駄に処理が増えていることが分かります。