ついにヒープソートなんだけど、その前に選択ソート
最初は配列全体から最小値を探す、見つかった値は配列の1番左と交換
次は左から2番目以降から最小値を探す、見つかった値は左から2番めと交換
次は左から3番目以降から...これを繰り返して右端まで行ったら完了
Public Sub SelectSort2(v As Variant)
Dim i As Long, tmp As Variant, min As Variant
Dim p As Long
For i = LBound(v) To UBound(v) - 1
min = v(i)
p = i '最小値のIndex入れる用
For j = i + 1 To UBound(v)
If min > v(j) Then
min = v(j)
p = j '最小値のIndex
End If
Next
'交換
tmp = v(i)
v(i) = min
v(p) = tmp
Next
End Sub
比較する回数はバブルソートと変わらないから遅いのかなあと予想しつつ
1万件をソートの時間計測
バブルソートは10秒だったから2倍以上速い！
コード的にはバブルソートより簡単な気がするんだけどね、速い
ここから本番のヒープソート
ヒープソートと選択ソートに共通しているのが最小値(か最大値)を探し出して順番に並べるってところ
違うのは探す方法
ヒープソートはヒープ(ヒープ構造)ってのを使って探す
ヒープってのは日本語だと二分木らしい
けどどっちも聞いたことないよ
形で言うとこういうのがヒープらしい親と子があって親のしたには子が2つある状態、
親から2つ分かれているから二分木なのかも
これだと要素を3つしか扱えないけど、子の下にさらに子を付け足していくことができる、親から見たら孫みたいね
番号を付ける
上から下へ、左から右へ順番に番号をつけていくと都合がいい
0番の子は1番と2番ってことになって
1番の親は0番、1番の子は3番と4番
5番の親は2番ってことがわかる
中途半端な変な形
要素数が増えて8個の場合はこうなる
3番の子は7番しかないけどこの形でもヒープ
順番に番号をつけられたってことは配列と同じように使えるってこと
v = Array(1, 3, 2)
っていう配列をヒープに当てはめていくと↓になる
●の右上の数値は番号で
●の中は配列の値
少し戻って
ヒープには親が上で子が下にあるっていう位置関係以外にもルールがあって
親の数値＞＝子の数値
親は子の数値より大きいことがヒープの条件
さっきの配列をヒープに当てはめたのを見ると、0番の数値1は子の数値3と2よりも小さいのでヒープじゃないってことなる
正しいヒープに修正するには上から見ていく方法と下からがあるみたい
今回は上から見ていくので0番から
0番の子は1番と2番、どちらの数値も親より大きいけど、より大きい方と交換する
交換したところ
これで正しいヒープになった
こういうのを繰り返していくと一番上が最大値になるのでこれを取り出して順番に並べると整列できるってのがヒープソートみたい
自分の親や子の番号を求める方法
親の番号を求める
親や子と比較するときはその番号が必要になる
配列の添字が0からの場合の自分の親の番号の求め方
(自分の番号-1)\2
\は割り算の商部分(小数点以下切り捨て)なので
例えば自分の番号が4なら親の番号は
(4-1)/2=1.5=1
図で見ても4番の親は1番であっている
0番から14番までの親の番号一覧で確認
Quotientは割り算の商を返す
配列の添字が0番から始まっていればこれで行けるんだけど0以上のときは使えなくて
(自分の番号 + 開始添字 - 1) \ 2
になる
4から始まる配列で7番の親番号は
(7+4-1)/2=5
1番から始まるときもこれでOK
今度は子の番号を求める
左の子＝自分の番号*2+1
右の子＝自分の番号*2+2、または左＋1
自分が2番のときの子の番号は
左=2*2+1=5
右=2*2+2=6
あってる
これも添字が0からの配列の場合だけなので
0以上から始まる配列のときは
左の子＝自分の番号 * 2 - (開始添字 - 1)
右の子＝自分の番号 * 2 - (開始添字)、または左＋1
これで準備が整ったので配列をヒープにしていく
添字は0から始まる配列Array(5, 3, 1, 4, 6, 2)を0番から順番に
0番に5を入れて、1番に3を入れたところ
親の番号は
(自分の番号-1)\2
なので
(1-1)\2=0番
親は0番
親(5)>子(3)のルールはあっているので次へ
2番に1を入れたところ
2番の親の番号は(2-1)\2=0で0番
比較して
これもあっているので次へ
3番に4を追加
3番の親の番号は(3-1)\2=1で1番
比較すると自分(子)のほうが大きいので交換
交換した
交換した先の関係を見る
1番の親の番号は0番
比較すると今度はあっているので次へ
4番に6を追加
4番の親の番号は(4-1)\2=1で1番
比較すると自分(子)のほうが大きいので交換
1番と4番を交換した
交換した先の関係を見る
1番の親の番号は0番
比較すると子のほうが大きいので交換
0番と1番を交換した
交換した先の関係を見る
0番の親はないので次へ
5番に次の値(2)を追加した
5番の親の番号は(5-1)\2=2で2番
比較すると子のほうが大きいので交換
2番と5番を交換した
交換した先の関係を見ると
2番の親の番号は0番
比較するとあっているので次へ
配列の最後の要素まで来たので終了
元の配列の並びはArray(5, 3, 1, 4, 6, 2)こうだったのが
(6, 5, 2, 3, 4, 1)となった、まだ整列(ソート)できていないけどヒープ構造にはなっている
一つ一つの最小単位のヒープでは親の値>子の値というルールは守られている
この状態になると一番上(0番)には最大値が入るはずなので
最大値が判明したことになる
ここまでをVBAにしたのが
Dim i As Long, j As Long, tmp As Variant
Dim p As Long 'parent index親番号
Dim ei As Long 'end index、自分の番号(最後尾番号)
For i = 1 To UBound(v)
ei = i
p = (ei - 1) \ 2 '親番号
'親の値＞子の値になるまで交換ループ
Do While v(p) < v(ei)
'比較して必要なら交換を繰り返す
tmp = v(p)
v(p) = v(ei)
v(ei) = tmp
ei = p
p = (ei - 1) \ 2 '親番号
Loop
Next
外側のループはFor〜Nextをつかっている、1から開始して配列の最後までループ、0からじゃないのは0番の親はないから
内側のループはDo While〜Loopをつかっている、追加した自分の親の値と比較して自分のほうが大きければ交換、交換した先でも親と比較して必要なら交換を繰り返して自分のほうが小さくなるまでこのループを続けるのでループ条件は
親の値 < 自分の値、v(p) < v(ei)
ループを抜けたら外側のループなので2番3番と同じように追加していく
Array(5, 3, 1, 4, 6, 2)を渡すと
(5, 3, 1, 4, 6, 2)→(6, 5, 2, 3, 4, 1)
図で見ると
こうなった、あっている
0番には最大値が入っているし小さな単位のヒープは
親の値 > 子の値という正しい状態
次はは整列していく作業
最大値がある0番と最後尾の5番を交換する
交換した
5番は最大値が入ったので整列済みになるので以降は無視して、残りの0番から4番までを作業の対象にする
次は交換した0番のせいでヒープが崩れてしまったので修正していく、0番から見ていく
図を見れば0番と1番を交換すればいいのがわかる
まず子同士の比較をして大きい方と親(自分)を比較する
子のほうが大きければ交換、小さければそのまま
0番は一番上で必ず親なので子の番号を求める
子の番号は
左の子＝自分の番号*2+1
右の子＝自分の番号*2+2、または左＋1
なので
左=0*2+1=1
右=0*2+2=2
1番と2番を比較して大きいのは1番
1番と0番を比較して1番のほうが大きいので交換になる
交換した
次も同じように子とのヒープ状態をみて正しくなければ交換していく
図を見ればわかるけど1番と4番を入れ替えれば正しくなる
1番の子の番号は
左＝1*2+1=3、右=1*2+2=4、比較して4番のほうが大きい
4番と自分を比較して4番のほうが大きいので交換
交換した
4番の子は無いのでこれで修正は完了
ヒープが正しくなると0番に最大値が入っていることになるので
0番と最後尾の4番を交換する
最後尾といっても5番じゃなくて4番になるのは
5番はもう整列済みで無視するところだから
交換した
これで5番に続き4番も整列済みなので以降は無視、対象外
次はまた0番を交換したせいでヒープが崩れたので
0番から修正していく
0番と1番を交換した
1番の子は3番と4番になっているけど4番は整列済みなので
3番と比較、交換になる
1番と3番を交換した
修正完了したので0番と最後尾を入れ替える
交換した
これで3番から5番まで整列済み
また0番から修正していく
0番と1番を交換
1番の子は整列済みなので修正完了
0番を最後尾と交換する
交換した
今度は0番を見てもヒープは正しいので修正無しでOK
0番と最後尾を交換
交換した
0番以外は整列済みで比較対象がなくなったので
全て整列済みになる
ヒープソート完成！
ここまでの修正しながらの整列をVBAにすると
'上から修復
'ソート部分
Dim c1 As Long 'child1 index
Dim c2 As Long 'child2 index
Dim k As Long
For ei = UBound(v) To 1 Step -1
p = 0 'ParentIndex初期化
Do
'子同士の比較、大きい方のIndex取得
c1 = p * 2 + 1 '左の子Index
c2 = c1 + 1 '右の子
If c2 > ei Then '右Indexが最後尾を超えていたら
k = c1 '自動的に左Indexを採用
ElseIf v(c1) > v(c2) Then '子同士の比較
k = c1
Else
k = c2
End If
'自分(親)と大きい方の子を比較
If v(k) > v(p) Then
'子が大きければ交換
tmp = v(k)
v(k) = v(p)
v(p) = tmp
p = k '自分のIndexを入れ替えた先のIndexに変更
Else
'子が小さければ修復完了
Exit Do
End If
'自分の左の子がなくなるまでループ
Loop While p * 2 + 1 < ei
'先頭(最大値)とソート範囲の最後尾を入れ替える
tmp = v(0)
v(0) = v(ei)
v(ei) = tmp
Next
ループは2つ、外側のループは要素の総数から1づつ減らしていって1になるまでループ、減らしていっているのは整列済みがどんどん増えていくからその分を除くため
内側のループはDo〜Loopでループ条件の
p * 2 + 1 < eiは
左の子の番号 < 最後尾番号
つまり自分の子がなくなるまでループ
内側ループの前半は子同士の比較をして大きい方の番号を取得
後半はその大きい方の子と自分を比較して子が小さければ修復完了なので内側ループ抜けして、大きければ交換してループを続ける
内側ループが終わったら最大値と最後尾を交換して外側ループ
最後尾番号が1になったらソート完了
これでソート部分もできたのでさっきの配列をヒープにしていくのと合わせるとヒープソートの完成↓
'添字が0から始まる配列だけに対応したヒープソート
Public Function HeapSort3_1(v As Variant) As Variant
Dim i As Long, j As Long, tmp As Variant
Dim p As Long 'parent index親番号
Dim ei As Long 'end index、最後尾番号
'ヒープ構造作成
'元の配列をそのまま使う
For i = 1 To UBound(v)
ei = i
p = (ei - 1) \ 2 '親番号
'親の値＞子の値になるまで交換ループ
Do While v(p) < v(ei)
'比較して必要なら交換を繰り返す
tmp = v(p)
v(p) = v(ei)
v(ei) = tmp
ei = p
p = (ei - 1) \ 2 '親番号
Loop
Next
'上から修復ソート部分
Dim c1 As Long 'child1 index
Dim c2 As Long 'child2 index
Dim k As Long
For ei = UBound(v) To 1 Step -1
p = 0 'ParentIndex初期化
Do
'子同士の比較、大きい方のIndex取得
c1 = p * 2 + 1 '左の子Index
c2 = c1 + 1 '右の子
If c2 > ei Then '右Indexが最後尾を超えていたら
k = c1 '自動的に左Indexを採用
ElseIf v(c1) > v(c2) Then '子同士の比較
k = c1
Else
k = c2
End If
'自分(親)と大きい方の子を比較、子が大きければ交換
If v(k) > v(p) Then
tmp = v(k)
v(k) = v(p)
v(p) = tmp
p = k '自分のIndexを入れ替えた先のIndexに変更
Else
Exit Do
End If
Loop While p * 2 + 1 < ei
'先頭(最大値)とソート範囲の最後尾を入れ替える
tmp = v(0)
v(0) = v(ei)
v(ei) = tmp
Next
HeapSort3_1 = v
End Function
やっとできたヒープソートはどれくらい速いのか
ランダム数値の1万件ソート
速い！
今までのまとめ
だんだん長くなってきた
グラフで
前回のマージソートよりは速い結果になった
バブル、シェーカーの遅い組
挿入、選択の中間組
コム、シェル、マージ、ヒープの速い組
3つに分かれる感じかなあ
100万件ソート
1万件ではマージソートより速かったのに
100万件にしたら逆転してしまった
参照したところ
マージソートも難しかったけどヒープソートはさらに時間がかかった、4日くらいかかってやっとまともなのができたんだったかなあ
最初できたのは1万件をソートで10分(815秒)以上もかかるものだったｗ
そこから一応これくらいなのかなっていう1秒台まで縮めたあとは一旦諦めてマージソートを書いていたみたいで、その後に何か思いついて0.1秒になって今回の0.085秒までは1週間くらいかかったのかなあ、それでも理解できていないから本当はもっと速いのかも、でももうヒープソートはお腹いっぱい
残るは最速と言われているクイックソートなんだけど、これが全然わかんなくて3秒もかかるものしか書けてない
'開始添字が0以上でもOKのヒープソート
さっきのヒープソートは添字は0からしか対応していないけど、エクセルでは1から始まる配列を扱うことが多いので書いた
ほとんど一緒で違うのはループの条件とループの開始位置
Public Function HeapSort4_1(v As Variant) As Variant
Dim i As Long, j As Long, tmp As Variant
Dim c As Long
Dim min As Long: min = LBound(v)
Dim ei As Long 'end index
'ヒープ構造作成
'元の配列をそのまま使う
For i = min + 1 To UBound(v)
ei = i
p = (ei + min - 1) \ 2
Do While p > min And v(p) < v(ei)
tmp = v(p)
v(p) = v(ei)
v(ei) = tmp
ei = p
p = (ei + min - 1) \ 2
Loop
Next
'上から修復
'ソート部分
Dim c1 As Long 'child1 index
Dim c2 As Long 'child2 index
Dim k As Long
ei = UBound(v)
For ei = UBound(v) To min + 1 Step -1
p = min 'ParentIndex初期化
Do
'子同士の比較、大きい方のIndex取得
c1 = p * 2 - (min - 1) '左の子Index
c2 = c1 + 1 '右の子
If c2 > ei Then '右Indexが最後尾を超えていたら
k = c1 '自動的に左Indexを採用
ElseIf v(c1) > v(c2) Then '子同士の比較
k = c1
Else
k = c2
End If
'自分(親)と大きい方の子を比較、子が大きければ交換
If v(k) > v(p) Then
tmp = v(k)
v(k) = v(p)
v(p) = tmp
p = k '自分のIndexを入れ替えた先のIndexに変更
Else
Exit Do
End If
Loop While p * 2 - (min - 1) < ei
'先頭(最大値)とソート範囲の最後尾を入れ替える
tmp = v(min)
v(min) = v(ei)
v(ei) = tmp
Next
HeapSort4_1 = v
End Function
これを使ってSheet3のA1からA10000をソートしてB列に貼り付けるマクロ
Sub bubble1000()
Dim v() As Variant
Dim y As Long: y = 10000
v = WorksheetFunction.Transpose(Sheets("Sheet3").Range("a1:a" & y))
v = HeapSort4_1(v)
Sheets("Sheet3").Range("b1:b" & y) = WorksheetFunction.Transpose(v)
End Sub
次回
関連記事
![[11]](https://s.yimg.jp/i/jp/blog/p3/images/paging_for2.gif){kind=small}
