エクセルVBAでバブルソート
バブルソート
隣の数値を比較して
- 左が大きい場合は数値を入れ替え
- 左が大きくない場合は入れ替えしない
この処理を左から右へ行う
右端まで達したら、また左から繰り返す
繰り返す(ループさせる)回数は数値の数-1
だいたいこんな感じだと思う、大きい数値を右へ右へと移動させる感じ
例えば{3, 4, 1, 3, 2}を{1, 2, 3, 3, 4}に小さい順に並べ替えするとき
1回目のループ
- 3,4,1,3,23と4を比較する、左の3は右の4より大きくないので入れ替えない
- 3,4,1,3,24と2を比較する、左の4は右の2より大きいので入れ替える
- 3,1,4,3,2入れ替えた
- 3,1,4,3,24と3を比較する、左の4は右の1より大きいので入れ替える
- 3,1,3,4,2入れ替えた
- 3,1,3,4,24と2を比較する、左の4は右の2より大きいので入れ替える
- 3,1,3,2,4入れ替えた、右端まで来たので次のループへ
これをまた左から繰り返していくと小さい順に並ぶことになる
繰り返す回数は並べ替えるものの個数-1
3,4,1,3,2と5つの場合は5-1=4回繰り返す
2回めは
- 3,1,3,2,4入れ替える
- 1,3,3,2,4入れ替えた
- 1,3,3,2,4そのまま
- 1,3,3,2,4入れ替える
- 1,3,2,3,4入れ替えた
- 1,3,2,3,4そのまま
3回めは
- 1,3,2,3,4
- 1,3,2,3,4
- 1,2,3,3,4
- 1,2,3,3,4
- 1,2,3,3,4
4回目
- 1,2,3,3,4
- 1,2,3,3,4
- 1,2,3,3,4
- 1,2,3,3,4
これで並べ替え完了
この手順をVBAで書いたのが
'バブルソート
'探索範囲不変更＆毎回入れ替え
Function testBubble1(v As Variant) As Variantこれを
Dim i As Long, j As Long
Dim temp As Variant
For i = 0 To UBound(v)
For j = 0 To UBound(v) - 1
'左(j)＞右(j+1)なら数値を入れ替える
If v(j) > v(j + 1) Then
'入れ替え
tmp = v(j)
v(j) = v(j + 1)
v(j + 1) = tmp
End If
Next
Next
testBubble1 = v
End Function
Sub sortTestBubble()こんなふうに呼び出すと
v = Array(3, 4, 1, 3, 2)
v = testBubble1(v)
End Sub
３，４，１，３，２ が １，２，３，３，４になって返ってくる
並べ替えできている
1万件の並べ替えのタイムは18.90234秒
このままでもいいけど、もう少し効率良くできる
さっきの処理一覧
1回目が終わった時点(7番目)で必ず右端の数値は最大値になるので2回めには比較する必要がないから省くことができる
ってことは2回目は3,1,3,2,4のうち3,1,3,2だけ比較すればいい
同じように2回めが終わったときの1,3,2,3、これも右端が最大値なので3回目はこれを省いて1,3,2だけ比較すればいい
こんなふうに繰り返しごとに1個減らすことができる
1回目
- 3,4,1,3,2
- 3,4,1,3,2
- 3,1,4,3,2
- 3,1,4,3,2
- 3,1,3,4,2
- 3,1,3,4,2
- 3,1,3,2,4
2回め
- 3,1,3,2,4
- 1,3,3,2,4
- 1,3,3,2,4
- 1,3,3,2,4
- 1,3,2,3,4
3回めは
- 1,3,2,3,4
- 1,3,2,3,4
- 1,2,3,3,4
4回目
- 1,2,3,3,4
この方法をさっきのtestBubble1に取り入れたのがtestBubble2
↓
'探索範囲変更＆毎回入れ替え
Public Function testBubble2(v As Variant) As Variant
Dim i As Long, j As Long
Dim c As Long: c = 1
Dim tmp As Variant
For i = 0 To UBound(v)
For j = 0 To UBound(v) - c '比較範囲をループ回数分狭くする
'左(j)＞右(j+1)なら数値を入れ替える
If v(j) > v(j + 1) Then
'入れ替え
tmp = v(j)
v(j) = v(j + 1)
v(j + 1) = tmp
End If
Next
c = c + 1 'ループ回数カウントUp
Next
testBubble2 = v
End Function
1万件の並べ替えのタイムは12.27734秒
約1.5倍速くなった
もう少し速くなるかも？
配列の中の値を入れ変えるときの処理は3手
tmp = v(j)’左の値を適当な変数に入れる
v(j) = v(j + 1)’右の値を左にコピー
v(j + 1) = tmp’適当な変数に入れておいた値を右にコピー
これを
左の値を適当な変数tmpに入れてこれを右と比較していく
tmp＜右なら左にtmpの値を戻してかわりに右の値をtmpに入れて次へ
tmp＞右なら右の値を左にコピーして次へ
つまり右の数値が小さいければ入れ替えは発生しないでコピーするだけなので手数は1手で済む
1回目のループだと
- 3,4,1,3,2tmp=3<4=Trueなのでtmpを入れ替え
- 3,1,1,3,2tmp=4<1=Falseなので1を左へコピー
- 3,1,3,3,2tmp=4<3=Falseなので3を左へコピー
- 3,1,3,2,2tmp=4<2=Falseなので2を左へコピー
- 3,1,3,2,4最後はtmpを戻す
合計手数は入れ替え2回なのでこれで2x3=6とコピーが3回で合計9回かな、この場合だと全く変わらないかも
左側に大きい数値がない配列だと逆に遅くなるかも
でも一応書いてみたのがこれtestBubble3
'探索範囲変更＆必要なときだけ入れ替え
Public Function testBubble3(v As Variant) As Variant
Dim i As Long, j As Long
Dim c As Long: c = 1
Dim tmp As Variant
For i = 0 To UBound(v)
tmp = v(0) '比較する数値をtmpに入れる
For j = 0 To UBound(v) - c
'tmp＞右(j+1)なら左へ上書き
If tmp > v(j + 1) Then
'右の値を左へ上書き
v(j) = v(j + 1)
Else
'tmpの値を配列に戻す
v(j) = tmp
'tmpに右(j+1)の数値を入れる
tmp = v(j + 1)
End If
Next
v(j) = tmp 'ループの最後はtmpの値を配列に戻す
c = c + 1
Next
testBubble3 = v
End Function
1万件の並べ替えのタイムは
速くなった、何回か計測したけどだいたい10秒
タイム計測のコード
0から1万までのランダム整数値の1万件の配列を作成してタイム計測
Sub sortTestBubble2()
Dim c As Long: c = 10000
Dim v() As Variant
ReDim v(c - 1)
For i = 0 To c - 1
v(i) = CInt(c * Rnd)
Next
Dim st As Single
st = Timer
'v = testBubble1(v)
'v = testBubble2(v)
v = testBubble3(v)
MsgBox Timer - st & "秒"
End Sub
バブルソート - Wikipedia読んでもあんまりわからないのよね、でも動作例のところはわかりやすい
https://ja.wikipedia.org/wiki/%E3%83%90%E3%83%96%E3%83%AB%E3%82%BD%E3%83%BC%E3%83%88
バブルソートはソートアルゴリズムの中では遅いけど単純ってことらしい、たしかに隣と比べて交換するだけだからねえ、でもプログラムコードに変換するのは結構時間かかったなあ
Wikipediaに載っているソートアルゴリズムを自分なりに書いて試したタイム結果
Wikipediaみたら他にもいろいろあるってことでいろいろ試してた
速い順
0～9999の整数のランダム1万件をエクセルVBAで、
シェルソート0.06秒、
コムソート0.1秒、
マージソート0.2、
ヒープソート1.1、
クイックソート(偽)2.8、
選択ソート4.7、
挿入ソート5.2、
シェイカーソート8、
バブルソート12、
奇偶転置ソート12、
ノームソート16
シェルソートとコムソートはそんなに間違っていないと思う、バブルソートの100倍以上速いってスゴイよね、これを思いついた人は天才だ思う
マージソートとヒープソートは難しすぎてわかっていないのでホントはもっと速いはず、とくにヒープソートは3日くらいかかった、ヒープソートは変態だと思う
クイックソートは全然書けていない
今のところシェルソートが一番速いんだけど、もっと速いのがエクセルの並べ替え！でも同じ並べ替えをするにもいろいろな方法があって特徴があって面白いねえってところ