前にVBAでクイックソートをする方法を紹介しましたが、配列の扱いがよく分からず、CSVに変換して行う方法でした。
今回、配列の処理方法が分かったので、コードを書き直してみました。
処理が劇的に速くなりました。バブルソートなど他のソートとは比較になりません。
クイックソート
クイックソートは次の手順で行います。
- どれか一つの要素(ピボット)を取得。ここでは先頭の要素。
- その他の要素を一つずつピボットと比較して大きい配列と小さい配列に分配。
- これらの配列を再帰的にクイックソート。
- 小さい配列、ピボット、大きい配列に並べて新しい配列を生成。
Function quick_sort(arrs)
Dim ub As Long, ub_front As Long, ub_rear As Long
Dim pivot As Double
Dim i As Long, x As Long, y As Long, z As Long
'要素が1個の場合
If UBound(arrs) < 1 Then
quick_sort = arrs
Exit Function
End If
'ピボットとの大小で別の配列に
ub = UBound(arrs)
pivot = arrs(0)
ReDim front(ub)
ReDim rear(ub)
x = 0
y = 0
For i = 1 To ub
If arrs(i) < pivot Then
front(x) = arrs(i)
x = x + 1
Else
rear(y) = arrs(i)
y = y + 1
End If
Next i
'処理後の配列を生成
ReDim new_arrs(ub)
z = 0
'前方の配列(ピボットより小)
If x > 0 Then
ReDim Preserve front(x - 1)
front = quick_sort(front) '再帰的にソート
ub_front = UBound(front)
For i = 0 To ub_front
new_arrs(z) = front(i)
z = z + 1
Next i
End If
'ピボット
new_arrs(z) = pivot
z = z + 1
'後方の配列(ピボットより大)
If y > 0 Then
ReDim Preserve rear(y - 1)
rear = quick_sort(rear) '再帰的にソート
ub_rear = UBound(rear)
For i = 0 To ub_rear
new_arrs(z) = rear(i)
z = z + 1
Next i
End If
quick_sort = new_arrs
End Function
Dim ub As Long, ub_front As Long, ub_rear As Long
Dim pivot As Double
Dim i As Long, x As Long, y As Long, z As Long
'要素が1個の場合
If UBound(arrs) < 1 Then
quick_sort = arrs
Exit Function
End If
'ピボットとの大小で別の配列に
ub = UBound(arrs)
pivot = arrs(0)
ReDim front(ub)
ReDim rear(ub)
x = 0
y = 0
For i = 1 To ub
If arrs(i) < pivot Then
front(x) = arrs(i)
x = x + 1
Else
rear(y) = arrs(i)
y = y + 1
End If
Next i
'処理後の配列を生成
ReDim new_arrs(ub)
z = 0
'前方の配列(ピボットより小)
If x > 0 Then
ReDim Preserve front(x - 1)
front = quick_sort(front) '再帰的にソート
ub_front = UBound(front)
For i = 0 To ub_front
new_arrs(z) = front(i)
z = z + 1
Next i
End If
'ピボット
new_arrs(z) = pivot
z = z + 1
'後方の配列(ピボットより大)
If y > 0 Then
ReDim Preserve rear(y - 1)
rear = quick_sort(rear) '再帰的にソート
ub_rear = UBound(rear)
For i = 0 To ub_rear
new_arrs(z) = rear(i)
z = z + 1
Next i
End If
quick_sort = new_arrs
End Function
使用例
次のサンプルでは、5000件のランダムな配列を作り、上の関数でソートし、シートに書き出します。
書き出しに時間がかかりますが、ソートそのものは一瞬で終わります。
Sub test()
Dim arrs(5000)
Dim new_arrs
Dim i As Long
For i = 0 To 5000
arrs(i) = Rnd()
Next i
new_arrs = quick_sort(arrs)
For i = 0 To UBound(new_arrs)
Cells(i + 1, 1) = new_arrs(i)
Next i
End Sub
Dim arrs(5000)
Dim new_arrs
Dim i As Long
For i = 0 To 5000
arrs(i) = Rnd()
Next i
new_arrs = quick_sort(arrs)
For i = 0 To UBound(new_arrs)
Cells(i + 1, 1) = new_arrs(i)
Next i
End Sub
コメント
[…] ちなみにquicksortのアルゴリズムはここ 再帰プロシージャはここを参考にさせてもらいました。 […]