Ответить в теме

Сообщение

[QUOTE="лис.хвост, post: 215444, member: 10770"]
Сортировка - упорядочивание элементов в списке.  В случае, когда элемент списка имеет несколько полей, поле, служащее критерием порядка, называется ключом сортировки. На практике в качестве ключа часто выступает число, а в остальных полях хранятся какие-либо данные, никак не влияющие на работу алгоритма.
Существуют алгоритмы [SIZE=4]устойчивой сортировки, алгоритмы неустойчивой сортировки, непрактичные алгоритмы сортировки и алгоритмы, не основанные на сравнениях. Рассмотрим некоторые из них.[/SIZE]
[B]Сортировка выбором[/B]
[B][URL="https://ru.wikipedia.org/wiki/%D0%A1%D0%BE%D1%80%D1%82%D0%B8%D1%80%D0%BE%D0%B2%D0%BA%D0%B0_%D0%B2%D1%8B%D0%B1%D0%BE%D1%80%D0%BE%D0%BC"]Сортировка выбором — Википедия[/URL][/B]
[code=vbnet]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
[/code]

[B]Сортировка простыми обменами[/B], [B]сортировка пузырьком[/B]
[B][URL="https://ru.wikipedia.org/wiki/%D0%A1%D0%BE%D1%80%D1%82%D0%B8%D1%80%D0%BE%D0%B2%D0%BA%D0%B0_%D0%BF%D1%83%D0%B7%D1%8B%D1%80%D1%8C%D0%BA%D0%BE%D0%BC"]Сортировка пузырьком — Википедия[/URL][/B]
[code=vbnet]    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
[/code]

[B]Сортировка вставками[/B]
[B][URL="https://ru.wikipedia.org/wiki/%D0%A1%D0%BE%D1%80%D1%82%D0%B8%D1%80%D0%BE%D0%B2%D0%BA%D0%B0_%D0%B2%D1%81%D1%82%D0%B0%D0%B2%D0%BA%D0%B0%D0%BC%D0%B8"]Сортировка вставками — Википедия[/URL][/B]
[code=vbnet]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
[/code]

[B]Сортировка слиянием[/B]
[B][URL="https://ru.wikipedia.org/wiki/%D0%A1%D0%BE%D1%80%D1%82%D0%B8%D1%80%D0%BE%D0%B2%D0%BA%D0%B0_%D1%81%D0%BB%D0%B8%D1%8F%D0%BD%D0%B8%D0%B5%D0%BC"]Сортировка слиянием — Википедия[/URL][/B]

[code=vbnet]    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
[/code]
[B]Сортировка с помощью двоичного дерева[/B]
[B][URL="https://ru.wikipedia.org/wiki/%D0%A1%D0%BE%D1%80%D1%82%D0%B8%D1%80%D0%BE%D0%B2%D0%BA%D0%B0_%D1%81_%D0%BF%D0%BE%D0%BC%D0%BE%D1%89%D1%8C%D1%8E_%D0%B4%D0%B2%D0%BE%D0%B8%D1%87%D0%BD%D0%BE%D0%B3%D0%BE_%D0%B4%D0%B5%D1%80%D0%B5%D0%B2%D0%B0"]Сортировка с помощью двоичного дерева — Википедия[/URL][/B]
[code=vbnet]    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
[/code]

[B]Сортировка подсчётом
[URL="https://ru.wikipedia.org/wiki/%D0%A1%D0%BE%D1%80%D1%82%D0%B8%D1%80%D0%BE%D0%B2%D0%BA%D0%B0_%D0%BF%D0%BE%D0%B4%D1%81%D1%87%D1%91%D1%82%D0%BE%D0%BC"]Сортировка подсчётом — Википедия[/URL][/B]
[code=vbnet]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
[/code]

[B]Сортировка Шелла[/B]
[B][URL="https://ru.wikipedia.org/wiki/%D0%A1%D0%BE%D1%80%D1%82%D0%B8%D1%80%D0%BE%D0%B2%D0%BA%D0%B0_%D0%A8%D0%B5%D0%BB%D0%BB%D0%B0"]Сортировка Шелла — Википедия[/URL][/B]
[code=vbnet]    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
[/code]
[B]Пирамидальная сортировка[/B]
[B][URL="https://ru.wikipedia.org/wiki/%D0%9F%D0%B8%D1%80%D0%B0%D0%BC%D0%B8%D0%B4%D0%B0%D0%BB%D1%8C%D0%BD%D0%B0%D1%8F_%D1%81%D0%BE%D1%80%D1%82%D0%B8%D1%80%D0%BE%D0%B2%D0%BA%D0%B0"]Пирамидальная сортировка — Википедия[/URL][/B]
[code=vbnet]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
[/code]
[B]Быстрая сортировка[/B]
[B][URL="https://ru.wikipedia.org/wiki/%D0%91%D1%8B%D1%81%D1%82%D1%80%D0%B0%D1%8F_%D1%81%D0%BE%D1%80%D1%82%D0%B8%D1%80%D0%BE%D0%B2%D0%BA%D0%B0"]Быстрая сортировка — Википедия[/URL][/B]

[code=vbnet]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
[/code]

[code=vbnet]'Процедура для сортировки массива методом двоичных вставок
'
'Входные параметры:
'    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
[/code]

[code=vbnet]    'Процедура для сортировки массива методом выборки
    '
    'Входные параметры:
    '    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
[/code]
[/QUOTE]

Проверка