За минувшее лето разобрана программа единомышленника
и создана улучшенная QB64 Qbasic рекурсивная
Русская сортировка половинами Russian Sorting Halves
показывающая результаты:
там где пузырьковая сортирует 100'ооо за 230 секунд
там где пузырьковая половинами 100'ооо за 70 секунд
там Рекурсия Русская сортировка половинами за 0,33 секунды
и миллион сортирует за 3,5 секунды именно в QB64 Qbasic
повторяю: 1'000'ooo сортирует за 3,5 секунды в QB64 Qbasic
и приветствую версии на других языках программирования
особенно где возможна визуализация и сравнение сортировок
Русская сортировка половинами важные действия визуализация
Russian sorting halves important actions visualization
RussianSortingHalvesDAV: Excel рекурсия таблица AlgoLab
только изменённая мной часть RussianSortingHalvesDAV
исправлен ляп лишних вычислений среднего и без лишних переменных
и без замедляющего оформления: сортирует максимум 250 ячеек за 10 секунд
быстрее в 12 раз чем также ускоренная обычная сортировка
Код
'RussianSortingHalvesDAV
Private Sub SortThanos()
Dim LevelMax As Long
With Sheets("process")
.Activate
LevelMax = 2 * Log(lngArrayCount)
If LevelMax > 0 Then
Call RussianSortingHalvesDAV(1, lngArrayCount, 1, LevelMax)
End If
End With
End Sub
Private Sub RussianSortingHalvesDAV(j1 As Long, j2 As Long, Level As Long, LevelMax As Long)
Dim j As Long
Dim Sum As Long
Dim Average As Double
Dim Left As Long
Dim Right As Long
Dim Column As Long
Dim strAverage As String
With Sheets("process")
.Activate
If j2 - j1 < 1 Then
Exit Sub
End If
For j = j1 To j2
Sum = Sum + .Cells(1, j)
Next
Average = Sum / (j2 - j1 + 1)
Left = j1 - 1
Right = j2 + 1
For j = j1 To j2
If .Cells(1, j) <= Average Then
Left = Left + 1
Column = Left
Else
Right = Right - 1
Column = Right
End If
.Cells(7, Column) = .Cells(1, j)
.Cells(1, j) = ""
Next
For j = j1 To j2
.Cells(1, j) = .Cells(7, j)
.Cells(7, j) = ""
Next
.Rows("7:8").Delete
If Level < LevelMax Then
If Left >= j1 Then Call RussianSortingHalvesDAV(j1, Left, Level + 1, LevelMax)
If Right <= j2 Then Call RussianSortingHalvesDAV(Right, j2, Level + 1, LevelMax)
End If
End With
End Sub
RussianSortingHalvesDAV.bas: рекурсия QB64 Qbasic QuickBasic Basic рекурсия
Код
' Russian Sorting Halves DANILIN
DECLARE SUB RussianSortingHalvesDAV (j1!, j2!, Level!, LevelMax!)
CLOSE: OPEN "c:/N.txt" FOR INPUT AS #5
INPUT #5, n: PRINT n
DIM SHARED d(2, n) AS LONG
OPEN "c:/ISX.txt" FOR INPUT AS #1
FOR i = 1 TO n: INPUT #1, d(1, i): NEXT
IF n < 17 THEN FOR k = 1 TO n: PRINT d(1, k);: NEXT: PRINT
IF n > 16 THEN FOR k = n - 10 TO n: PRINT d(1, k);: NEXT: PRINT
start = TIMER
LevelMax = 2 * LOG(n)
PRINT n, LevelMax
IF LevelMax > 0 THEN
CALL RussianSortingHalvesDAV(1, n, 1, LevelMax)
END IF
finish = TIMER
IF n < 17 THEN FOR k = 1 TO n: PRINT d(1, k);: NEXT: PRINT
IF n > 16 THEN FOR k = n - 10 TO n: PRINT d(1, k);: NEXT: PRINT
PRINT finish - start
OPEN "c:/=RuSortHalves_dav.txt" FOR OUTPUT AS #2
PRINT #2, finish - start; "sekung "
PRINT #2, n; "el", "RECURSION"
FOR i = 1 TO n: PRINT #2, d(1, i): NEXT
END
SUB RussianSortingHalvesDAV (j1, j2, Level, LevelMax)
IF j2 - j1 < 1 THEN EXIT SUB
FOR j = j1 TO j2
Sum = Sum + d(1, j)
NEXT
Average = Sum / (j2 - j1 + 1)
Levo = j1 - 1
Prav = j2 + 1
FOR j = j1 TO j2
IF d(1, j) < Average THEN
Levo = Levo + 1
Column = Levo
ELSE
Prav = Prav - 1
Column = Prav
END IF
d(2, Column) = d(1, j)
NEXT
FOR j = j1 TO j2
d(1, j) = d(2, j):
NEXT
IF Level < LevelMax THEN
IF Levo >= j1 THEN CALL RussianSortingHalvesDAV(j1, Levo, Level + 1, LevelMax)
IF Prav <= j2 THEN CALL RussianSortingHalvesDAV(Prav, j2, Level + 1, LevelMax)
END IF
END SUB
