Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
#Debug Error On
#Debug Display On
#Include "Cwindow.inc"
Type MyType
s As String * 8
a As Long
b As Long
' c as Long
End Type
%IDC_ButtonA = 500
%IDC_ButtonB = 501
Global hDlg As Dword, qStart,qStop,qFreq As Quad, fName$, ElementCount As Long
Function PBMain() As Long
Dialog New Pixels, 0, "On Disk Sort",300,300,200,200, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, %IDC_ButtonA,"Create Data", 50,10,100,20
Control Add Button, hDlg, %IDC_ButtonB,"Sort", 50,40,100,20
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Select Case Cb.Msg
Case %WM_InitDialog
Randomize Timer
fName$ = "bigsort.dat"
ElementCount = 1000000
QueryPerformanceFrequency qFreq
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_ButtonA
CreateTestData
Case %IDC_ButtonB
QueryPerformanceCounter qStart
Open fName$ For Random As #1 Len = Len(MyType)
OnDiskQuickSort 1, ElementCount
Close #1
QueryPerformanceCounter qStop
? "Sort complete: " + Format$((qStop-qStart)/qFreq,"###.00000") & " seconds"
End Select
End Select
End Function
Sub CreateTestData
Local i As Long, tempUDT As MyType
If IsFile(fName$) Then Kill fName$
Open fName$ For Binary As #1
For i = 1 To ElementCount
tempUDT.s = Format$(Rnd(0,20),"00000000")
Put #1,,tempUDT
Next i
Close #1
End Sub
Sub OnDiskQuickSort(Lower As Long, Upper As Long)
Local tmpLow,tmpHi As Long, UDTtempLow, UDTtempHi, pivot As MyType
tmpLow = Lower : tmpHi = Upper
Get #1, (Lower+Upper)/2, pivot
While (tmpLow <= tmpHi)
Get #1, tmpLow, UDTtempLow
While (UDTtempLow.s < pivot.s) And (tmpLow < Upper)
Incr tmpLow
Get #1, tmpLow, UDTtempLow
Wend
Get #1, tmpHi, UDTtempHi
While (pivot.s < UDTtempHi.s) And (tmpHi > Lower)
Decr tmpHi
Get #1, tmpHi, UDTtempHi
Wend
If (tmpLow <= tmpHi) Then
Swap UDTtempLow, UDTtempHi
Put #1, tmpLow, UDTtempLow
Put #1, tmpHi, UDTtempHi
Incr tmpLow : Decr tmpHi
End If
Wend
If (Lower < tmpHi) Then OnDiskQuickSort Lower, tmpHi
If (tmpLow < Upper) Then OnDiskQuickSort tmpLow, Upper
End Sub
'gbs_01214
'Date: 05-11-2013
http://www.garybeene.com/sw/gbsnippets.htm