Dim S1(L To R) As String Dim P1(L To R) As Long Dim L1(L To R) As Long For I = L To R S1(I) = GetRandomString() P1(I) = I L1(I) = GetRandomLong() Next I
pQuickSortS L, R, S1, P1 QuickSortL L, R, L1
Sub pQuickSortS(L As Long, R As Long, A() As String, P() As Long) A(L - 1) = MinStr A(R + 1) = MaxStr pQuickS L, R, A(), P pInsertS L, R, A(), P End Sub
Sub pQuickS(L As Long, R As Long, A() As String, P() As Long) Dim MED As Long Dim LP As Long Dim RP As Long Dim Pivot As String Dim TMP As Long If R - L > 12 Then MED = (L + R) \ 2 TMP = P(MED) P(MED) = P(L) P(L) = TMP If A(P(L + 1)) > A(P(R)) Then TMP = P(L + 1) P(L + 1) = P(R) P(R) = TMP End If If A(P(L)) > A(P(R)) Then TMP = P(L) P(L) = P(R) P(R) = TMP End If If A(P(L + 1)) > A(P(L)) Then TMP = P(L + 1) P(L + 1) = P(L) P(L) = TMP End If Pivot = A(P(L)) LP = L RP = R + 1 Do Do LP = LP + 1 Loop While A(P(LP)) < Pivot Do RP = RP - 1 Loop While A(P(RP)) > Pivot If RP < LP Then Exit Do TMP = P(LP) P(LP) = P(RP) P(RP) = TMP Loop TMP = P(L) P(L) = P(RP) P(RP) = TMP If (RP - 1) - L < R - LP Then pQuickS L, RP - 1, A, P pQuickS LP, R, A, P Else pQuickS LP, R, A, P pQuickS L, RP - 1, A, P End If End If End Sub
Sub pInsertS(L As Long, R As Long, A() As String, P() As Long) Dim LP As Long Dim RP As Long Dim TMP As Long Dim T As String For RP = L + 1 To R TMP = P(RP) T = A(TMP) For LP = RP To L + 1 Step -1 If T < A(P(LP - 1)) Then P(LP) = P(LP - 1) Else Exit For Next LP P(LP) = TMP Next RP End Sub
Sub QuickSortL(L As Long, R As Long, A() As Long) A(L - 1) = MinStr A(R + 1) = MaxStr QuickL L, R, A InsertL L, R, A End Sub
Sub QuickL(L As Long, R As Long, A() As Long) Dim MED As Long Dim LP As Long Dim RP As Long Dim Pivot As String Dim TMP As Long If R - L > 12 Then MED = (L + R) \ 2 TMP = A(MED) A(MED) = A(L) A(L) = TMP If A(L + 1) > A(R) Then TMP = A(L + 1) A(L + 1) = A(R) A(R) = TMP End If If A(L) > A(R) Then TMP = A(L) A(L) = A(R) A(R) = TMP End If If A(L + 1) > A(L) Then TMP = A(L + 1) A(L + 1) = A(L) A(L) = TMP End If Pivot = A(L) LP = L RP = R + 1 Do Do LP = LP + 1 Loop While A(LP) < Pivot Do RP = RP - 1 Loop While A(RP) > Pivot If RP < LP Then Exit Do TMP = A(LP) A(LP) = A(RP) A(RP) = TMP Loop TMP = A(L) A(L) = A(RP) A(RP) = TMP If (RP - 1) - L < R - LP Then QuickL L, RP - 1, A QuickL LP, R, A Else QuickL LP, R, A QuickL L, RP - 1, A End If End If End Sub
Sub InsertL(L As Long, R As Long, A() As Long) Dim LP As Long Dim RP As Long Dim TMP As Long For RP = L + 1 To R TMP = A(RP) For LP = RP To L + 1 Step -1 If TMP < A(LP - 1) Then A(LP) = A(LP - 1) Else Exit For Next LP A(LP) = TMP Next RP End Sub |