Сортировка в VBScript
От: dimzon Россия http://dimzon541.narod.ru
Дата: 01.07.03 08:28
Оценка: :)
Мож кому пригодится?
'###############################################################################################################################
' Реализация алгоритма быстрой сортировки
'###############################################################################################################################

Option Explicit
'###############################################################################################################################
' Процедура быстрой сортировки массива (QuickSort)
' [in,out]    aArrayToSort - подлежащий сортировке массив
' [in]        oSortCompareFunction - функция-делегат для вычисления позиции элемента в результирующем массиве
'                должна иметь прототип SomeFunction(a,b,vCustomData)
'                должна возвращать true если элемент "а" д.б. расположен выше элемента "b"
' [in]        bDesc - признак обратной сортировки
' [in]        vCustomData - дополнительные пользовательские данные, передаваемые в функцию-делегат
Sub X_QuickSortArray(ByRef aArrayToSort, oSortCompareFunction, bDesc,  ByRef vCustomData)

    If Not IsArray(aArrayToSort) Then
        ' Сортировать то нечего!
        Exit Sub
    End If
    
    If 0=(UBound(aArrayToSort)-LBound(aArrayToSort)+1) Then
        ' Сортировать то нечего!
        Exit Sub
    End If
    
    ' А теперь отсортируем
    X_QuickSortArrayPartial aArrayToSort, _
            oSortCompareFunction, _
            bDesc, _ 
            vCustomData, _ 
            LBound(aArrayToSort), _
            UBound(aArrayToSort), _
            IsObject( aArrayToSort( LBound( aArrayToSort)))
End Sub

'###############################################################################################################################
' Процедура быстрой сортировки части массива (QuickSort)
' [in,out]    aArrayToSort - подлежащий сортировке массив
' [in]        oSortCompareFunction - функция-делегат для вычисления позиции элемента в результирующем массиве
'                должна иметь прототип SomeFunction(a,b,vCustomData)
'                должна возвращать true если элемент "а" д.б. расположен выше элемента "b"
' [in]        bDesc - признак обратной сортировки
' [in]        vCustomData - дополнительные пользовательские данные, передаваемые в функцию-делегат
' [in]        nLeft - первый элемент границ сортировки
' [in]        nRight - последний элемент границ сортировки
' [in]        bIsObjectArray - признак работы с массивом объектов
Sub X_QuickSortArrayPartial(ByRef aArrayToSort, oSortCompareFunction, bDesc, ByRef vCustomData, _
                                    nLeft, nRight, bIsObjectArray)
    
    '##################################################################################
    '#                                                                                #
    '#   Это стандартная реализация алгоритма быстрой сортировки, без комментариев!   #
    '#                                                                                #
    '##################################################################################
    '#                                                                                #
    '#   The QuickSort algorithm is explained in thorough detail in the               #
    '#        Visual Basic Language Developer's Handbook                                # 
    '#                by Ken Getz and Mike Gilbert (Sybex, 2000)                        #
    '#                                                                                #
    '##################################################################################
    
    Dim I, J, P, L, R, T
    
    L = nLeft
    R = nRight
    
    Do
        I = L
        J = R
        P = ((L + R) \ 2)
        Do
            If bDesc Then
                While oSortCompareFunction( aArrayToSort(P), aArrayToSort(I), vCustomData)
                    I = I + 1
                Wend
                While oSortCompareFunction( aArrayToSort(J), aArrayToSort(P), vCustomData)
                    J = J - 1
                Wend
            Else
                While oSortCompareFunction( aArrayToSort(I), aArrayToSort(P), vCustomData)
                    I = I + 1
                Wend
                While oSortCompareFunction( aArrayToSort(P), aArrayToSort(J), vCustomData)
                    J = J - 1
                Wend
            End If    
            
            If I <= J Then
                If bIsObjectArray Then
                    Set T = aArrayToSort(I)
                    Set aArrayToSort(I) = aArrayToSort(J)
                    Set aArrayToSort(J) = T
                    Set T = Nothing
                Else
                    T = aArrayToSort(I)
                    aArrayToSort(I) = aArrayToSort(J)
                    aArrayToSort(J) = T
                    T = Null
                End If
                If P = I Then
                    P = J
                ElseIf P = J Then
                    P = I
                End If
                I = I + 1
                J = J - 1
            End If
        Loop Until I > J
        
        If L < J Then 
            X_QuickSortArrayPartial aArrayToSort, oSortCompareFunction, bDesc, vCustomData, L, J, bIsObjectArray
        End If    
        L = I
    Loop Until I >= R
End Sub

'###############################################################################################################################
' Функция - делегат для сравнения произвольных скалярных данных
Function X_AnyCompare(a,b,vUseless)
    X_AnyCompare = a<b
End Function

'###############################################################################################################################
' Функция - делегат для сравнения произвольных строковых данных
Function X_StringCompare(a,b,nCompareMode)
    X_StringCompare=(-1=StrComp(a,b,nCompareMode))
End Function
... << RSDN@Home 1.0 beta 7a >>
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.