[VB6] Сортировка массивов

Тема в разделе "Банк полезных кодов", создана пользователем лис.хвост, 14 сен 2015.

  1. лис.хвост
    Оффлайн

    лис.хвост VIP Разработчик

    Сообщения:
    631
    Симпатии:
    983
    Сортировка - упорядочивание элементов в списке. В случае, когда элемент списка имеет несколько полей, поле, служащее критерием порядка, называется ключом сортировки. На практике в качестве ключа часто выступает число, а в остальных полях хранятся какие-либо данные, никак не влияющие на работу алгоритма.
    Существуют алгоритмы устойчивой сортировки, алгоритмы неустойчивой сортировки, непрактичные алгоритмы сортировки и алгоритмы, не основанные на сравнениях. Рассмотрим некоторые из них.
    Сортировка выбором
    Сортировка выбором — Википедия
    Код (vb.net):
    Dim indM, k, i, arr() As Single
    n = 5
    ReDim arr(1 To n)
    arr(1) = 4
    arr(2) = -3
    arr(3) = 0
    arr(4) = 3
    arr(5) = -10
    Dim Min As Single
    For i = 1 To n - 1
    Min = arr(i)
    k_min = i
      For j = i + 1 To n
      If arr(j) < Min Then
       Min = arr(j)
       k_min = j
      End If
      Next
      arr(k_min) = arr(i)
      arr(i) = Min
    Next
     
    Сортировка простыми обменами, сортировка пузырьком
    Сортировка пузырьком — Википедия
    Код (vb.net):
        Public Sub BubbleSort(ByRef Arr() As Double, ByRef N As Long)
            Dim I As Long
            Dim J As Long
            Dim Tmp As Double
         
            For I = 0# To N - 1# Step 1
                For J = 0# To N - 2# - I Step 1
                    If Arr(J) > Arr(J + 1#) Then
                        Tmp = Arr(J)
                        Arr(J) = Arr(J + 1#)
                        Arr(J + 1#) = Tmp
                    End If
                Next J
            Next I
        End Sub
     
    Сортировка вставками
    Сортировка вставками — Википедия
    Код (vb.net):
    Public Sub InsertionSort(ByRef Arr() As Double, ByVal N As Long)
        Dim I As Long
        Dim J As Long
        Dim K As Long
        Dim Tmp As Double
        If N=1# then
            Exit Sub
        End If
        N = N-1#
        i = 1#
        Do
            j = 0#
            Do
                If Arr(i)<=Arr(j) then
                    k = i
                    Tmp = Arr(i)
                    Do
                        Arr(k) = Arr(k-1#)
                        k = k-1#
                    Loop Until  Not k>j
                    Arr(j) = Tmp
                    j = i
                Else
                    j = j+1#
                End If
            Loop Until  Not j<i
            i = i+1#
        Loop Until  Not i<=n
    End Sub
     
    Сортировка слиянием
    Сортировка слиянием — Википедия

    Код (vb.net):
        Public Sub MergeSort(ByRef Arr() As Double, ByVal N As Long)
            Dim C As Boolean
            Dim I As Long
            Dim I1 As Long
            Dim I2 As Long
            Dim N1 As Long
            Dim N2 As Long
            Dim J As Long
            Dim K As Long
            Dim Tmp As Double
            Dim BArr() As Double
            Dim MergeLen As Long
       
            ReDim BArr(0# To N - 1#)
            MergeLen = 1#
            C = True
            Do While MergeLen < N
                If C Then
                    I = 0#
                    Do While I + MergeLen <= N
                        I1 = I + 1#
                        I2 = I + MergeLen + 1#
                        N1 = I + MergeLen
                        N2 = I + 2# * MergeLen
                        If N2 > N Then
                            N2 = N
                        End If
                        Do While I1 <= N1 Or I2 <= N2
                            If I1 > N1 Then
                                Do While I2 <= N2
                                    I = I + 1#
                                    BArr(I - 1#) = Arr(I2 - 1#)
                                    I2 = I2 + 1#
                                Loop
                            Else
                                If I2 > N2 Then
                                    Do While I1 <= N1
                                        I = I + 1#
                                        BArr(I - 1#) = Arr(I1 - 1#)
                                        I1 = I1 + 1#
                                    Loop
                                Else
                                    If Arr(I1 - 1#) > Arr(I2 - 1#) Then
                                        I = I + 1#
                                        BArr(I - 1#) = Arr(I2 - 1#)
                                        I2 = I2 + 1#
                                    Else
                                        I = I + 1#
                                        BArr(I - 1#) = Arr(I1 - 1#)
                                        I1 = I1 + 1#
                                    End If
                                End If
                            End If
                        Loop
                    Loop
                    I = I + 1#
                    Do While I <= N
                        BArr(I - 1#) = Arr(I - 1#)
                        I = I + 1#
                    Loop
                Else
                    I = 0#
                    Do While I + MergeLen <= N
                        I1 = I + 1#
                        I2 = I + MergeLen + 1#
                        N1 = I + MergeLen
                        N2 = I + 2# * MergeLen
                        If N2 > N Then
                            N2 = N
                        End If
                        Do While I1 <= N1 Or I2 <= N2
                            If I1 > N1 Then
                                Do While I2 <= N2
                                    I = I + 1#
                                    Arr(I - 1#) = BArr(I2 - 1#)
                                    I2 = I2 + 1#
                                Loop
                            Else
                                If I2 > N2 Then
                                    Do While I1 <= N1
                                        I = I + 1#
                                        Arr(I - 1#) = BArr(I1 - 1#)
                                        I1 = I1 + 1#
                                    Loop
                                Else
                                    If BArr(I1 - 1#) > BArr(I2 - 1#) Then
                                        I = I + 1#
                                        Arr(I - 1#) = BArr(I2 - 1#)
                                        I2 = I2 + 1#
                                    Else
                                        I = I + 1#
                                        Arr(I - 1#) = BArr(I1 - 1#)
                                        I1 = I1 + 1#
                                    End If
                                End If
                            End If
                        Loop
                    Loop
                    I = I + 1#
                    Do While I <= N
                        Arr(I - 1#) = BArr(I - 1#)
                        I = I + 1#
                    Loop
                End If
                MergeLen = 2# * MergeLen
                C = Not C
            Loop
            If Not C Then
                I = 1#
                Do
                    Arr(I - 1#) = BArr(I - 1#)
                    I = I + 1#
                Loop Until Not I <= N
            End If
    End Sub
     
    Сортировка с помощью двоичного дерева
    Сортировка с помощью двоичного дерева — Википедия
    Код (vb.net):
        Public Sub HeapSort(ByRef Arr() As Double, ByVal N As Long)
            Dim I As Long
            Dim J As Long
            Dim K As Long
            Dim T As Long
            Dim Tmp As Double
         
            If N = 1# Then
                Exit Sub
            End If
            I = 2#
            Do
                T = I
                Do While T <> 1#
                    K = T \ 2#
                    If Arr(K - 1#) >= Arr(T - 1#) Then
                        T = 1#
                    Else
                        Tmp = Arr(K - 1#)
                        Arr(K - 1#) = Arr(T - 1#)
                        Arr(T - 1#) = Tmp
                        T = K
                    End If
                Loop
                I = I + 1#
            Loop Until Not I <= N
            I = N - 1#
            Do
                Tmp = Arr(I)
                Arr(I) = Arr(0#)
                Arr(0#) = Tmp
                T = 1#
                Do While T <> 0#
                    K = 2# * T
                    If K > I Then
                        T = 0#
                    Else
                        If K < I Then
                            If Arr(K) > Arr(K - 1#) Then
                                K = K + 1#
                            End If
                        End If
                        If Arr(T - 1#) >= Arr(K - 1#) Then
                            T = 0#
                        Else
                            Tmp = Arr(K - 1#)
                            Arr(K - 1#) = Arr(T - 1#)
                            Arr(T - 1#) = Tmp
                            T = K
                        End If
                    End If
                Loop
                I = I - 1#
            Loop Until Not I >= 1#
        End Sub
     
    Сортировка подсчётом
    Сортировка подсчётом — Википедия

    Код (vb.net):
    Sub Task()
    Dim X(1 To 2500000) As Integer
        Randomize
        For i& = 1 To 2500000
            X(i&) = Rnd * 300
        Next i&
        For i& = 20000 To 20400
            Debug.Print X(i&)
        Next i&
        SortCount X
        For i& = 20000 To 20400
            Debug.Print X(i&)
        Next i&
    End Sub
    Sub SortCount(X() As Integer)
    Dim Y(0 To 300) As Long
        For i& = 1 To UBound(X, 1)
            j& = X(i&)
            Y(j&) = Y(j&) + 1
        Next i&
        k& = 1
        For j& = 0 To 300
            If Y(j&) > 0 Then
               For i& = 1 To Y(j&)
                   X(k&) = j&
                   k& = k& + 1
               Next i&
            End If
        Next j&
    End Sub
     
    Сортировка Шелла
    Сортировка Шелла — Википедия
    Код (vb.net):
        Public Sub ShellSort(ByRef Arr() As Double, ByVal N As Long)
            Dim C As Boolean
            Dim G As Long
            Dim I As Long
            Dim J As Long
            Dim Tmp As Double
       
            N = N - 1#
            G = (N + 1#) \ 2#
            Do
                I = G
                Do
                    J = I - G
                    C = True
                    Do
                        If Arr(J) <= Arr(J + G) Then
                            C = False
                        Else
                            Tmp = Arr(J)
                            Arr(J) = Arr(J + G)
                            Arr(J + G) = Tmp
                        End If
                        J = J - 1#
                    Loop Until Not (J >= 0# And C)
                    I = I + 1#
                Loop Until Not I <= N
                G = G \ 2#
            Loop Until Not G > 0#
        End Sub
     
    Пирамидальная сортировка
    Пирамидальная сортировка — Википедия
    Код (vb.net):
    Public Sub HeapSort(ByRef Arr() As Double, ByVal N As Long)
        Dim I As Long
        Dim J As Long
        Dim K As Long
        Dim T As Long
        Dim Tmp As Double
        If N=1# then
            Exit Sub
        End If
        i = 2#
        Do
            t = i
            Do While t<>1#
                k = t\2#
                If Arr(k-1#)>=Arr(t-1#) then
                    t = 1#
                Else
                    Tmp = Arr(k-1#)
                    Arr(k-1#) = Arr(t-1#)
                    Arr(t-1#) = Tmp
                    t = k
                End If
            Loop
            i = i+1#
        Loop Until  Not i<=n
        i = n-1#
        Do
            Tmp = Arr(i)
            Arr(i) = Arr(0#)
            Arr(0#) = Tmp
            t = 1#
            Do While t<>0#
                k = 2#*t
                If k>i then
                    t = 0#
                Else
                    If k<i then
                        If Arr(k)>Arr(k-1#) then
                            k = k+1#
                        End If
                    End If
                    If Arr(t-1#)>=Arr(k-1#) then
                        t = 0#
                    Else
                        Tmp = Arr(k-1#)
                        Arr(k-1#) = Arr(t-1#)
                        Arr(t-1#) = Tmp
                        t = k
                    End If
                End If
            Loop
            i = i-1#
        Loop Until  Not i>=1#
    End Sub
     
    Быстрая сортировка
    Быстрая сортировка — Википедия

    Код (vb.net):
    Option Explicit
    Global CutOff As Long
    ' ************************************************
    ' Quicksort with:
    '   - Uses Rnd to select a random dividing value
    '   - Stops when there are fewer than CutOff items
    '       left to sort. It then finishes using
    '       SelectionSort.
    ' ************************************************
    Public Sub Quicksort(List() As Long, ByVal min As Long, ByVal max As Long)
    Dim med_value As Long
    Dim hi As Long
    Dim lo As Long
    Dim i As Long
        ' If the list has no more than CutOff elements,
        ' finish it off with SelectionSort.
        If max - min < CutOff Then
            Selectionsort List(), min, max
            Exit Sub
        End If
        ' Pick the dividing value.
        i = Int((max - min + 1) * Rnd + min)
        med_value = List(i)
        ' Swap it to the front.
        List(i) = List(min)
        lo = min
        hi = max
        Do
            ' Look down from hi for a value < med_value.
            Do While List(hi) >= med_value
                hi = hi - 1
                If hi <= lo Then Exit Do
            Loop
            If hi <= lo Then
                List(lo) = med_value
                Exit Do
            End If
            ' Swap the lo and hi values.
            List(lo) = List(hi)
           
            ' Look up from lo for a value >= med_value.
            lo = lo + 1
            Do While List(lo) < med_value
                lo = lo + 1
                If lo >= hi Then Exit Do
            Loop
            If lo >= hi Then
                lo = hi
                List(hi) = med_value
                Exit Do
            End If
           
            ' Swap the lo and hi values.
            List(hi) = List(lo)
        Loop
       
        ' Sort the two sublists.
        Quicksort List(), min, lo - 1
        Quicksort List(), lo + 1, max
    End Sub
     
    Код (vb.net):
    'Процедура для сортировки массива методом двоичных вставок
    '
    'Входные параметры:
    '    Arr -   сортируемый массив.
    '            Нумерация элементов от 0 до N-1
    '    N   -   размер массива
    '  
    'Выходные параметры:
    '    Arr -   массив, упорядоченный по возрастанию.
    '            Нумерация элементов от 0 до N-1
    '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Public Sub BinaryInsertionSort(ByRef Arr() As Double, ByVal N As Long)
        Dim B As Long
        Dim C As Long
        Dim E As Long
        Dim I As Long
        Dim J As Long
        Dim K As Long
        Dim Tmp As Double
        For I=2# To N Step 1
            b = 1#
            e = i-1#
            c = (b+e)\2#
            Do While b<>c
                If Arr(c-1#)>Arr(i-1#) then
                    e = c
                Else
                    b = c
                End If
                c = (b+e)\2#
            Loop
            If Arr(b-1#)<Arr(i-1#) then
                If Arr(i-1#)>Arr(e-1#) then
                    b = e+1#
                Else
                    b = e
                End If
            End If
            k = i
            Tmp = Arr(i-1#)
            Do While k>b
                Arr(k-1#) = Arr(k-1#-1#)
                k = k-1#
            Loop
            Arr(b-1#) = Tmp
        Next I
    End Sub
     
    Код (vb.net):
        'Процедура для сортировки массива методом выборки
        '
        'Входные параметры:
        '    Arr -   сортируемый массив.
        '            Нумерация элементов от 0 до N-1
        '    N   -   размер массива
        '
        'Выходные параметры:
        '    Arr -   массив, упорядоченный по возрастанию.
        '            Нумерация элементов от 0 до N-1
        '
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Public Sub SelectionSort(ByRef arr() As Double, ByRef N As Long)
            Dim I As Long
            Dim J As Long
            Dim K As Long
            Dim M As Double
       
            For i=1# To N Step 1
                m = Arr(i-1#)
                k = i
                For j=i To n Step 1
                    If m>Arr(j-1#) then
                        m = Arr(j-1#)
                        k = j
                    End If
                Next j
                Arr(k-1#) = Arr(i-1#)
                Arr(i-1#) = m
            Next i
        End Sub
     
     
    orderman, Dragokas, Kиpилл и ещё 1-му нравится это.
  2. Сергей
    Оффлайн

    Сергей Активный пользователь

    Сообщения:
    254
    Симпатии:
    120
    Эх чуток опоздали. Совсем недавно сидел за испытаниями скоростей сортирования. Многомерный массив, где нужно упорядочить список файлов (~100 000) и паралельно со списками дат (создания, изменения, обращения), размеров, контрольных сумм, и первых строк файла. Пузырьковая сортировка давала больше 10 секунд, а выборочная дала около секунды.
    А вообще такие штучки ,как выбор метода, очень важны. Например если сравниваешь 2 маленьких файла, то алгоритм нужен тот, который быстрее напишешь. А если 2 файла огромные, и нужно создать отчет чего нет в одном файле и чего нет в другом, то метод простого построчного сравния даст результат через... несколько минут, в то время, как более сложный - с исключением уже ненужного и уменьшением востребованного в массиве... результат получаешь в течении секунды.
    Вот и выбирай - быстро написать алгоритм, или писать долго но быстро получить ответ. Как еще один пример - получить таблицу простых чисел 1 до 100 (результат будет получен "сразу" человек и не заметит), а вот от 1 до 10 миллионов - в зависимости от выбора алгоритма, скорость будет отличаться в десятки тысяч раз, которые решат - ждать "минуту", или "неделю"
    --- Объединённое сообщение, 14 сен 2015, Дата первоначального сообщения: 14 сен 2015 ---
    Хотя лично я пользуюсь для малых массивов листбоксом (у него ,правда, ограничено количество строк, но... ) В свойствах контрола ставлю Sorted = True, заполняю его массивом "прошу отсортировать" и считываю с него упорядоченный массив:
    Код (vb.net):

    Dim i As Integer
    Dim a(100) As String
    'a(0)=... , a(1)=... , ... , a(100)=... .

    List1.Sorted = True ' ! автосортировку можно установить ТОЛЬКО в свойствах контрола
    List1.Visible = False ' если невидимый, то работает намного быстрее (можно установить в свойствах)

    '(РАБОТА
    List1.Clear ' чистим после предыдущего раза

    For i = 0 To 100 ' обязательно с ноля, ведь с ноля начинается номерация строк
    List1.AddItem (a(i))
    Next i

    List1.Refresh ' обновляем = даем отсортироваться
    DoEvents

    For i = 0 To 100
    a(i) = List1.List(i)
    Next i
    'РАБОТА)
     
     
    Последнее редактирование модератором: 14 сен 2015
    orderman, Dragokas, Kиpилл и ещё 1-му нравится это.

Поделиться этой страницей