`Option ExplicitOption Compare BinaryOption Base 1Public Type TRIAL nKEYS As Long nITS As Integer PT As Long TT As Long ST As LongEnd TypePublic Const RAD = 1Public Const TQK = 2Public Const QUI = 3Public Const MER = 4Public Const HEA = 5Public Const COM = 6Public Const SHE = 7Public Const INS = 8Public Const SEL = 9Public Const LNG = 1Public Const DBL = 2Public Const STR = 3Public Const MinDbl = -1.7976931348623E+308Public Const MaxDbl = 1.7976931348623E+308Public Const MinLng = -2147483647Public Const MaxLng = 2147483647Public Const MinStr = " "Public Const MaxStr = "???????????????"Public TIMES(LNG To STR, RAD To SEL, 1 To 8) As TRIALPublic L0() As Long 'buffer for unsorted longsPublic L1() As Long 'buffer for sorted longsPublic L2() As Long 'extra buffer used by MergeSortPublic D() As Double 'buffer for unsorted doublesPublic pD0() As Long 'buffer for unsorted pointers to doublesPublic S() As String 'buffer for unsorted stringsPublic pS0() As Long 'buffer for unsorted pointers to stringsPublic B() As Byte 'buffers used by TernaryQuickSort & MSDRadixSortPublic pB() As LongPublic P() As Long 'buffer used for sorted pointersPublic RAW_LNGS As RangePublic SORTED_LNGS As RangePublic RAW_DBLS As RangePublic SORTED_DBLS As RangePublic RAW_STRS As RangePublic SORTED_STRS As RangePublic RESULTS As RangePublic NAMESPublic ROW As IntegerSub TrySorts() Dim NK Dim ITS Dim ITS2 Dim LEVEL As Integer Dim SORT As Integer Dim nKEYS As Long Dim nITS As Integer Dim nITS2 As Integer Dim T As Long Dim tL As Long Dim tD As Long Dim tS As Long Dim tB As Long Dim tL2 As Long Dim tD2 As Long Dim tS2 As Long Dim I As Integer NK = Array(150, 500, 1500, 5000, 15000, 50000, 150000, 500000) ITS = Array(3000, 1000, 300, 100, 30, 10, 3, 1) ITS2 = Array(2000, 200, 20, 2, 0, 0, 0, 0) NAMES = Array("RadixSort", "TernQuickSort", "QuickSort", "MergeSort", _ "HeapSort", "CombSort", "ShellSort", "InsertionSort", "SelectionSort") Say "Setting up ranges." Set RAW_LNGS = Cells(2, 1).Resize(50, 1) Set SORTED_LNGS = Cells(2, 2).Resize(50, 1) Set RAW_DBLS = Cells(2, 3).Resize(50, 1) Set SORTED_DBLS = Cells(2, 4).Resize(50, 1) Set RAW_STRS = Cells(2, 5).Resize(50, 1) Set SORTED_STRS = Cells(2, 6).Resize(50, 1) Set RESULTS = Cells(2, 8).Resize(1000, 8) RAW_LNGS.Clear SORTED_LNGS.Clear RAW_DBLS.Clear SORTED_DBLS.Clear RAW_STRS.Clear SORTED_STRS.Clear RESULTS.Clear Cells(1, 1).Value = "raw lngs" Cells(1, 2).Value = "sorted lngs" Cells(1, 3).Value = "raw dbls" Cells(1, 4).Value = "sorted dbls" Cells(1, 5).Value = "raw strs" Cells(1, 6).Value = "sorted strs" Cells(1, 8).Value = "sort" Cells(1, 9).Value = "type" Cells(1, 10).Value = "# of keys" Cells(1, 11).Value = "repeats" Cells(1, 12).Value = "prep time" Cells(1, 13).Value = "total time" Cells(1, 14).Value = "sort time" Cells(1, 15).Value = "time/rep" Say "Dimensioning arrays." ReDim L0(0 To 500001) ReDim L1(0 To 500001) ReDim L2(0 To 500001) ReDim D(0 To 500001) ReDim pD0(0 To 500001) ReDim S(0 To 500001) ReDim pS0(0 To 500001) ReDim B(0 To 5000001) ReDim pB(0 To 500001) ReDim P(0 To 500001) ROW = 1 For LEVEL = 4 To 8 Say "Level " & CStr(LEVEL) nKEYS = CLng(NK(LEVEL)) nITS = CInt(ITS(LEVEL)) nITS2 = CInt(ITS2(LEVEL)) Say "Measuring long prep times." GetRndLngs nKEYS, L0 ListLngs RAW_LNGS, L0, 50 ACopyL 1, nKEYS, L0, L1 T = Timer For I = 1 To nITS ACopyL 1, nKEYS, L0, L1 Next I tL = Timer - T T = Timer For I = 1 To nITS2 ACopyL 1, nKEYS, L0, L1 Next I tL2 = Timer - T Say "Measuring double prep times." GetRndDbls nKEYS, D, pD0 pListDbls RAW_DBLS, D, pD0, 50 ACopyL 1, nKEYS, pD0, P T = Timer For I = 1 To nITS ACopyL 1, nKEYS, pD0, P Next I tD = Timer - T T = Timer For I = 1 To nITS2 ACopyL 1, nKEYS, pD0, P Next I tD2 = Timer - T Say "Measuring string prep times." GetRndStrs nKEYS, 10, S, pS0 pListStrs RAW_STRS, S, pS0, 50 ACopyL 1, nKEYS, pS0, P T = Timer For I = 1 To nITS ACopyL 1, nKEYS, pS0, P Next I tS = Timer - T T = Timer For I = 1 To nITS2 ACopyL 1, nKEYS, pS0, P Next I tS2 = Timer - T Strs2Bytes S, 1, nKEYS, B, pB T = Timer For I = 1 To nITS Strs2Bytes S, 1, nKEYS, B, pB Next I tB = Timer - T For SORT = RAD To SEL Select Case SORT Case RAD RunSortB RAD, LEVEL, nKEYS, nITS, tB Case TQK RunSortB TQK, LEVEL, nKEYS, nITS, tB Case QUI RunSortL QUI, LEVEL, nKEYS, nITS, tL RunSortD QUI, LEVEL, nKEYS, nITS, tD RunSortS QUI, LEVEL, nKEYS, nITS, tS Case MER RunSortL MER, LEVEL, nKEYS, nITS, tL RunSortD MER, LEVEL, nKEYS, nITS, tD RunSortS MER, LEVEL, nKEYS, nITS, tS Case HEA RunSortL HEA, LEVEL, nKEYS, nITS, tL RunSortD HEA, LEVEL, nKEYS, nITS, tD RunSortS HEA, LEVEL, nKEYS, nITS, tS Case COM RunSortL COM, LEVEL, nKEYS, nITS, tL RunSortD COM, LEVEL, nKEYS, nITS, tD RunSortS COM, LEVEL, nKEYS, nITS, tS Case SHE RunSortL SHE, LEVEL, nKEYS, nITS, tL RunSortD SHE, LEVEL, nKEYS, nITS, tD RunSortS SHE, LEVEL, nKEYS, nITS, tS Case INS If LEVEL MAXCOLS Then Exit Sub End If BLK(ROW, COL).Value = A(I) If I Mod 10000 = 0 Then Say CStr(I) & " longs listed" Next IEnd SubSub LoadDbls(BLK As Range, A() As Double, P() As Long, N As Long) Dim ROW As Long Dim COL As Integer Dim V N = BLK.Columns.COUNT * BLK.Rows.COUNT If UBound(A) MAXCOLS Then Exit Sub End If BLK(ROW, COL).Value = A(P(I)) If I Mod 10000 = 0 Then Say CStr(I) & " doubles listed" Next IEnd SubSub LoadStrs(BLK As Range, A() As String, P() As Long, N As Long) Dim ROW As Long Dim COL As Integer Dim V N = BLK.Columns.COUNT * BLK.Rows.COUNT If UBound(A) MAXCOLS Then Exit Sub End If BLK(ROW, COL).Value = A(P(I)) If I Mod 10000 = 0 Then Say CStr(I) & " strings listed" Next IEnd SubSub pListBytes(BLK As Range, B() As Byte, P() As Long, ByVal N As Long, _ Optional MAXROWS As Long = 50000, Optional MAXCOLS As Integer = 1) Dim I As Long Dim ROW As Long Dim COL As Integer Dim J As Long Dim S As String For I = 1 To N ROW = I Mod MAXROWS If ROW = 0 Then ROW = MAXROWS ElseIf ROW = 1 Then COL = COL + 1 If COL > MAXCOLS Then Exit Sub End If S = "" J = P(I) Do S = S & Chr(B(J)) J = J + 1 Loop Until B(J) = 0 BLK(ROW, COL).Value = S If I Mod 10000 = 0 Then Say CStr(I) & " strings listed" Next IEnd SubSub Strs2Bytes(A() As String, L As Long, R As Long, B() As Byte, P() As Long) Dim StrNum As Long Dim nPtrs As Long Dim nBytes As Long Dim DEPTH As Integer nBytes = 0 nPtrs = 0 For StrNum = L To R nBytes = nBytes + Strings.Len(A(StrNum)) + 1 nPtrs = nPtrs + 1 Next StrNum ReDim B(1 To nBytes) ReDim P(1 To nPtrs) nPtrs = 1 nBytes = 1 For StrNum = L To R P(nPtrs) = nBytes For DEPTH = 1 To Strings.Len(A(StrNum)) B(nBytes) = Asc(Strings.MID(A(StrNum), DEPTH, 1)) nBytes = nBytes + 1 Next DEPTH B(nBytes) = 0 nBytes = nBytes + 1 nPtrs = nPtrs + 1 If StrNum Mod 10000 = 0 Then Say CStr(StrNum) & " converted" Next StrNumEnd SubSub ACopyS(L As Long, R As Long, A() As String, B() As String) Dim I As Long For I = L To R B(I) = A(I) Next IEnd SubSub ACopyL(L As Long, R As Long, A() As Long, B() As Long) Dim I As Long For I = L To R B(I) = A(I) Next IEnd SubSub ACopyD(L As Long, R As Long, A() As Double, B() As Double) Dim I As Long For I = L To R B(I) = A(I) Next IEnd SubSub GetRndStrs(CNT As Long, LENGTH As Integer, A() As String, P() As Long) Dim I As Long Dim J As Integer Dim C As Integer Dim S As String Randomize ReDim A(0 To CNT + 1) For I = 1 To CNT S = "" For J = 1 To LENGTH C = (Rnd() * 2999) Mod 47 If C 90 Then If I `