Алгоритм быстрой сортировки для двумерного массива. Получается, чем меньше столбцов, тем быстрее сортировка

@Thor · Регистрация: 12.12.2014

Студворк — интернет-сервис помощи студентам

Написал процедуру для сортировки двумерного массива.
Для того, чтобы можно было менять число строк в массиве с сохранением его значений (redim preserve) я сделал массивы так, что первая размерность - это столбцы, а вторая размерность - это строки. Строки я и сортирую.
Написанный алгоритм работает так, что чем меньше столбцов в массиве, тем медленнее происходит процесс сортировки.
Допустим
- 20001 строка, 1 столбец: время сортировки - 5.4 сек
- 20001 строка, 2 столбца: время сортировки - 1.7 сек
- 20001 строка, 3 столбца: время сортировки - 0.6 сек
- 20001 строка, 4 столбца: время сортировки - 0.4 сек
После некоторого количества столбцов скорость снова падает, например:
- 20001 строка, 200 столбцов: время сортировки - 4.5 сек (все равно быстрее, чем при одном столбце!)

Почему алгоритм так работает, понять не могу. Если кто-то подскажет, буду благодарен!
Сам по себе алгоритм работает правильно, т.е. массив оказывается сортирован.

Код программы:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
' Запуск
Private Sub TEST_Sorting()
    NR1& = 0: NR2& = 20000
    NC1& = 0: NC2& = 3
    
    Dim aV() As Long:  ReDim aV(NC1 To NC2, NR1 To NR2)
    
    For i = NC1 To NC2
        For j = NR1 To NR2
            aV(i, j) = CLng(Rnd() * 5)
        Next j
    Next i
 
    T# = Timer()
    QuickSort2DArrWithSecDimForRows aV
    Debug.Print "Quick sort: ", Timer() - T
End Sub
 
 
' [функция] Сортировка (быстрая) 2D массива, в котором для строк используется вторая размерность
Sub QuickSort2DArrWithSecDimForRows(ArrayOf2Dim As Variant)
    NR1& = LBound(ArrayOf2Dim, 2): NR2& = UBound(ArrayOf2Dim, 2)
    NC1& = LBound(ArrayOf2Dim, 1): NC2& = UBound(ArrayOf2Dim, 1)
 
    InnerOfQuickSort2DArrWithSecDimForRows ArrayOf2Dim, NR1, NR2, NC1, NC2
End Sub
 
 
Private Sub InnerOfQuickSort2DArrWithSecDimForRows(ByRef ArrayOf2Dim As Variant, _
                                                   ByRef NR1 As Long, _
                                                   ByRef NR2 As Long, _
                                                   ByRef NC1 As Long, _
                                                   ByRef NC2 As Long)
    If NR1 >= NR2 Then Exit Sub
 
    NRleft& = NR1
    NRRight& = NR2
    NRMid& = (NR1 + NR2) \ 2
 
    Do While NRleft < NRRight
        For i& = NRRight To NRMid + 1 Step -1
            If CompareTwoRowsOf2DArrWithSecDimForRows(ArrayOf2Dim, i, NRMid, NC1, NC2) = -1 Then
                SwapTwoRowsOf2DArrWithSecDimForRows ArrayOf2Dim, i, NRMid, NC1, NC2
                NRRight = i
                NRMid = i
                Exit For
            End If
        Next i
        If i = NRMid Then NRRight = i
        
        For i& = NRleft To NRMid - 1
            If CompareTwoRowsOf2DArrWithSecDimForRows(ArrayOf2Dim, i, NRMid, NC1, NC2) = 1 Then
                SwapTwoRowsOf2DArrWithSecDimForRows ArrayOf2Dim, i, NRMid, NC1, NC2
                NRleft = i
                NRMid = i
                Exit For
            End If
        Next i
        If i = NRMid Then NRleft = i
    Loop
    
    InnerOfQuickSort2DArrWithSecDimForRows ArrayOf2Dim, NR1, NRMid - 1, NC1, NC2
    
    InnerOfQuickSort2DArrWithSecDimForRows ArrayOf2Dim, NRMid + 1, NR2, NC1, NC2
    
End Sub
 
 
' [ФУНКЦИЯ] Сравнивает две строки в 2D-массиве, в котором для строк используется вторая размерность
' возвращает  1, ести строка 1 больше строки 2
' возвращает -1, ести строка 2 больше строки 1
' возвращает  0, ести строка 1 равна  строке 2
Function CompareTwoRowsOf2DArrWithSecDimForRows(ByRef ArrayOf2Dim As Variant, _
                                                ByRef IndexOfRow1 As Long, _
                                                ByRef IndexOfRow2 As Long, _
                                                ByRef ColumnFirstIndex As Long, _
                                                ByRef ColumnLastIndex As Long) As Integer
    For i& = ColumnFirstIndex To ColumnLastIndex
        If ArrayOf2Dim(i, IndexOfRow1) > ArrayOf2Dim(i, IndexOfRow2) Then
            CompareTwoRowsOf2DArrWithSecDimForRows = 1
            Exit Function
        ElseIf ArrayOf2Dim(i, IndexOfRow1) < ArrayOf2Dim(i, IndexOfRow2) Then
            CompareTwoRowsOf2DArrWithSecDimForRows = -1
            Exit Function
        End If
    Next i
End Function
 
' [ФУНКЦИЯ] Обменивает значения двух строк в 2D-массиве, в котором для строк используется вторая размерность
Sub SwapTwoRowsOf2DArrWithSecDimForRows(ByRef ArrayOf2Dim As Variant, _
                                             ByRef IndexOfRow1 As Long, _
                                             ByRef IndexOfRow2 As Long, _
                                             ByRef ColumnFirstIndex As Long, _
                                             ByRef ColumnLastIndex As Long)
    Dim TmpVar As Variant
    For i& = ColumnFirstIndex To ColumnLastIndex
        TmpVar = ArrayOf2Dim(i, IndexOfRow1)
        ArrayOf2Dim(i, IndexOfRow1) = ArrayOf2Dim(i, IndexOfRow2)
        ArrayOf2Dim(i, IndexOfRow2) = TmpVar
    Next i
End Sub

@Hugo121 · 29.05.2017, 12:47

Не вникал что там сортирует, но думаю полезно осмотреть результат (чуть переделал чтоб выводилось):

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
' Запуск
Private Sub TEST_Sorting()
    NR1& = 1: NR2& = 20000
    NC1& = 1: NC2& = 5
    
    Dim aV() As Long:  ReDim aV(NR1 To NR2, NC1 To NC2)
    
    For i = NC1 To NC2
        For j = NR1 To NR2
            aV(j, i) = CLng(Rnd() * 5)
        Next j
    Next i
 
   Cells.Clear
   [a1].Resize(NR2, NC2) = aV
 
    T# = Timer()
    QuickSort2DArrWithSecDimForRows aV
    Debug.Print "Quick sort: ", Timer() - T
    
    [a1].Offset(, NC2 + 1).Resize(NR2, NC2) = aV
End Sub

@_shark · 29.05.2017, 13:05

запустил вышеприведенный код и тоже не понял что там отсортировано. Возможно, этим и объясняется невероятная скорость сортировки

@Thor · 29.05.2017, 16:28 **[ТС]**

_shark, только что ещё раз перепроверил, все сортируется нормально. Могу предположить, что вы что-то не правильно скопировали.

Выкладываю заменённую функцию запуска, которая выводит результат (массив оказывается отсортирован):

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private Sub TEST_Sorting()
' Запуск
    NR1& = 0: NR2& = 100
    NC1& = 0: NC2& = 3
    
    Dim aV() As Long:  ReDim aV(NC1 To NC2, NR1 To NR2)
    
    For i = NC1 To NC2
        For j = NR1 To NR2
            aV(i, j) = CLng(Rnd() * 5)
        Next j
    Next i
 
 
    Dim TransposedArr() As Long: ReDim TransposedArr(NR1 To NR2, NC1 To NC2)
    For i = NR1 To NR2
        For j = NC1 To NC2
            TransposedArr(i, j) = aV(j, i)
        Next j
    Next i
    Range(Range("A1").Cells(1, 1), Range("A1").Cells(NR2 - NR1 + 1, NC2 - NC1 + 1)).Value = TransposedArr
    
    QuickSort2DArrWithSecDimForRows aV
    
For i = NR1 To NR2
        For j = NC1 To NC2
            TransposedArr(i, j) = aV(j, i)
        Next j
    Next i
    Range(Range("G1").Cells(1, 1), Range("G1").Cells(NR2 - NR1 + 1, NC2 - NC1 + 1)).Value = TransposedArr
    
End Sub

@Hugo121 · 29.05.2017, 16:47

Понял - код только один столбец или ряд сортирует - в моей попытке это очевидно была первая строка.
В этом варианте - первый столбец. Остальное лежит как попало...

@Thor · 29.05.2017, 19:14 **[ТС]**

Hugo121, код сортирует ВСЕ столбцы (т.е. перемещает строку целиком). Вот пример для 3 столбцов и 11 строк.

3 2 3
3 2 1
2 1 2
1 2 1
3 2 3
3 3 2
2 2 2
2 1 2
1 3 3
1 2 2
1 2 3

1 2 1
1 2 2
1 2 3
1 3 3
2 1 2
2 1 2
2 2 2
3 2 1
3 2 3
3 2 3
3 3 2

Сам код запускающей процедуры:

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Private Sub TEST_Sorting()
    NR1& = 0: NR2& = 10
    NC1& = 0: NC2& = 2
    
    Dim aV() As Long:  ReDim aV(NC1 To NC2, NR1 To NR2)
    
    For i = NC1 To NC2
        For j = NR1 To NR2
            aV(i, j) = CLng(1 + Rnd() * 2)
        Next j
    Next i
 
 
    Dim TransposedArr() As Long: ReDim TransposedArr(NR1 To NR2, NC1 To NC2)
    For i = NR1 To NR2
        For j = NC1 To NC2
            TransposedArr(i, j) = aV(j, i)
        Next j
    Next i
    Print2DArrayToDebug TransposedArr
    
    QuickSort2DArrWithSecDimForRows aV
    
    For i = NR1 To NR2
        For j = NC1 To NC2
            TransposedArr(i, j) = aV(j, i)
        Next j
    Next i
    Print2DArrayToDebug TransposedArr
    
End Sub
 
Sub Print2DArrayToDebug(Arr As Variant)
 
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        For j& = LBound(Arr, 2) To UBound(Arr, 2)
            ans = ans & vbTab & Arr(i, j)
        Next j
        ans = ans & vbNewLine
    Next i
    
    Debug.Print ans
    
End Sub

Новые блоги и статьи Все статьи Все блоги /
Модель микоризы: классовый агентный подход anaschu 02.01.2026 Раньше это было два гриба и бактерия. Теперь три гриба, растение. И на уровне агентов добавится между грибами или бактериями взаимодействий. До того я пробовал подход через многомерные массивы,. . .	Учёным и волонтёрам проекта «Einstein@home» удалось обнаружить четыре гамма-лучевых пульсара в джете Млечного Пути Programma_Boinc 01.01.2026 Учёным и волонтёрам проекта «Einstein@home» удалось обнаружить четыре гамма-лучевых пульсара в джете Млечного Пути Сочетание глобально распределённой вычислительной мощности и инновационных. . .	Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Programma_Boinc 28.12.2025 Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Налог на собак: https:/ / ********/ gallery/ V06K53e Финансовый отчет в Excel: https:/ / ********/ gallery/ bKBkQFf Пост отсюда. . .	Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Programma_Boinc 26.12.2025 Нашел на реддите интересную статью под названием Anyone know where to get a free Desktop or Laptop? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .	Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка. Programma_Boinc 23.12.2025 Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .
PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Как объединить две одинаковые БД Access с разными данными VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .

@_shark 193 / 191 / 31 Регистрация: 11.10.2016 Сообщений: 610
	29.05.2017, 13:05
	запустил вышеприведенный код и тоже не понял что там отсортировано. Возможно, этим и объясняется невероятная скорость сортировки Миниатюры 0

@Hugo121 6997 / 2895 / 555 Регистрация: 19.10.2012 Сообщений: 8,803
	29.05.2017, 16:47
	Понял - код только один столбец или ряд сортирует - в моей попытке это очевидно была первая строка. В этом варианте - первый столбец. Остальное лежит как попало... 0