Список. Помогите оценить сложность.

Автор dr.Faust, 24 июня 2010, 23:37

0 Пользователи и 1 гость просматривают эту тему.

VlhOwn

Так да не так.
Тут интересная штука получается - сортировка пирамидой произвольно заполненного массива получается эффективнее, чем построение пирамиды путем последовательного добавления элементов этого массива в том же порядке:
- когда у нас уже есть три элемента в позициях вершина-сын-сын, нам легко их правильно расставить, а поскольку мы движемся сверху-вниз, то правильность построения поддеревьев, корнями которых выступают сыновья, нас пока не волнует;
- когда же мы добавляем поэлементно, то у нас на каждом шаге получается правильно построенная пирамида, и добавление нового элемента, например, претендующего на новый корень всего дерева, порождает массовое перемещение элементов в массиве. Считать лень, но подозреваю, что эффективность будет не лучше, чем у сортировки вставкой.

Кстати, "и ее обходу для получения конечного результата" - лишнее, если куча правильно построена, то массив упорядочен.

JohnSUN

#16
И всё-таки она верти для каждого из вариантов задачи придется подбирать свой вариант сортировки.
Так, как задача была описана в вопросах Гугля не понятно, например, откуда берутся исходные данные: то ли список уже есть и его нужно обработать, то ли список будет вноситься в колонку электронной таблицы и его динамически нужно будет забрасывать в уже имеющийся - полностью отсортированный! - массив. Опять же - а каков размер исходного списка?

Давайте вспомним, что Вирт писал в анализе алгоритмов сортировки массивов:
ЦитироватьПузырьковая сортировка определенно худшая из всех сравниваемых. Ее усовершенствованная версия, шейкерная сортировка, продолжает оставаться плохой по сравнению с прямым включением и прямым выбором (за исключением патологического случая уже упорядоченного массива)
А во втором варианте постановки задачи мы именно этот "патологический случай" и имеем.
Да вы на время выполнения посмотрите! ShakerSort - the best! Но только для такого случая  :(
Сортировка кучей - хороша! Кода - 18 строчек на Модуле, ну, на Бэйсике будет строк на двенадцать-двадцать больше.
Чистый КвикСорт (рекурсивный) в большинстве случаев не подойдёт - поскольку предполагается использовать макрос в Calc'е. Из-за рекурсии будем постоянно нарываться на ошибки 522 - 523, хотя явных ошибок там не будет. Поэтому обвел рамочкой не рекурсивный вариант. Там чуток придется повозиться при переводе кода с Модулы, с имитацией стека через массив, поэтому длина кода вырастет. Но эффективность - по идее! - снизится не сильно.


Цитата: VlhOwn от 26 июня 2010, 10:25Кстати, "и ее обходу для получения конечного результата" - лишнее, если куча правильно построена, то массив упорядочен.
Виноват, невнятно выразился (а почему у нас все смайлики зелёные? Краснеющего смущённого нет?)
Имелось в виду, что если результат нужно забросить обратно в таблицу Calc'а, то проще и быстрее всего это сделать или вернув в качестве результата функции двумерный массив (и тогда "массивная" формула сама отрисует результат на листе), или в макросе шарахнуть все полученные данные через setDataArray(). А ему данные нужно передавать в виде этой хитрой структуры "массив массивов". То есть в этих случаях по итоговому массиву нужно будет пробежаться и перепаковать в другой вид. А если просто выполнить операцию и вернуть результат там же, в макросе - то конечно ничего больше не потребуется

[вложение удалено Администратором]
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

dr.Faust

#17
Цитата: JohnSUN от 26 июня 2010, 12:45Чистый КвикСорт (рекурсивный) в большинстве случаев не подойдёт - поскольку предполагается использовать макрос в Calc'е. Из-за рекурсии будем постоянно нарываться на ошибки 522 - 523, хотя явных ошибок там не будет.
?
С какого?
Класс, в том числе и с КвикСортом:
REM CLS:0:8:0
REM Оператор над массивами

Option Compatible
Option ClassModule

' флаг остоновки длительной операции
Private StopOperatinFlag As Boolean REM hide

' ПРЕОБРАЗОВАНИЕ __________________________________________________________________________________________________________________________________


' ПОИСК ___________________________________________________________________________________________________________________________________________


' СОРТИРОВКА ______________________________________________________________________________________________________________________________________


Private Sub QuickSort (Optional WorkArray As Variant)
REM caption
REM Сортировка одномерного массива алгоритмом быстрой обменной сортировки вставками
REM in
REM WorkArray As Variant - сортируемый массив
REM discription
REM Сортирует одномерный массив алгоритмом быстрой сортировки вставками.  Для массивов более 128 элементов используется однократный выбор медианного элемента из 3, для сокращения времени сортировки упорядоченных массивов.
Dim imax As Long
Dim imin As Long
Dim size As long
Dim centr As Long
' проверка входа
If IsMissing(WorkArray) Then Exit Sub
If Not(IsArray(WorkArray)) Then Exit Sub
If UBound(WorkArray,1) >= 0 Then Exit Sub


imin = LBound(WorkArray)
imax = UBound(WorkArray)
size = imax-imin



If size < 128 Then
QuickSort (WorkArray, imin, imax)
Else
centr = Int((imax-imin)/2)+imin ' находим цетнр массива
If WorkArray(imax)<WorkArray(centr) Then
tmpElm = WorkArray(imax)
WorkArray(imax) = WorkArray (centr)' свопимся 1
WorkArray (centr) = tmpElm ' свопимся 2
End If

If WorkArray(centr)>WorkArray(imin) Then
tmpElm = WorkArray(imin)
WorkArray(imin) = WorkArray (centr)' свопимся 1
WorkArray (centr) = tmpElm ' свопимся 2
Else
If WorkArray(imax)<WorkArray(imin) Then
tmpElm = WorkArray(imax)
WorkArray(imax) = WorkArray (imin)' свопимся 1
WorkArray (imin) = tmpElm ' свопимся 2
End If
End If
recQuickSort (WorkArray, imin, imax)
End If
End Sub


Private Sub recQuickSort (a As Variant, ByVal lb As Long, ByVal ub As Long) REM hide
Dim imin As Long
Dim imax As Long
Dim i As Long
Dim j As Long
Dim jm As Long
Dim jp As Long
Dim pv As Variant
Dim tmpElm As Variant

imin = lb
imax = ub

i = imin + 1
j = imax
pv = a(imin)
Do While j>=i
Do While a(i) < pv
i = i+1
If i>imax Then
i=imax
Exit Do
End If
Loop
Do While a(j) > pv
j = j-1
If j<imin Then
j=imin
Exit Do
End If
Loop
If j>i then
' обмен
tmpElm = a(i)
a(i) = a(j)
a(j) = tmpElm
i = i+1
j = j-1
Else
Exit Do
End If
Loop

'вставка опорного элемента
' обмен
a(imin) = a(j)
a(j) = pv
' рекурсивный вызов
' левый подмассив
jm = j-1
If jm - imin > 0 Then
If jm - imin > 1 Then ' --- обход рекурсии при подмассиве равном 2 элементам
recQuickSort (a, imin, jm)
Else ' --- обход рекурсии при подмассиве равном 2 элементам
If a(imin)>a(jm) Then ' --- обход рекурсии при подмассиве равном 2 элементам
tmpElm = a(imin) ' --- обход рекурсии при подмассиве равном 2 элементам
a(imin) = a(jm) ' --- обход рекурсии при подмассиве равном 2 элементам
a(jm) = tmpElm ' --- обход рекурсии при подмассиве равном 2 элементам
End If ' --- обход рекурсии при подмассиве равном 2 элементам
End If ' --- обход рекурсии при подмассиве равном 2 элементам
End if
' правый подмассив
jp = j+1
If imax - jp > 0 Then
If imax - jp > 1 Then ' --- обход рекурсии при подмассиве равном 2 элементам
recQuickSort (a, jp, imax)
Else ' --- обход рекурсии при подмассиве равном 2 элементам
If a(jp)>a(imax) Then ' --- обход рекурсии при подмассиве равном 2 элементам
tmpElm = a(imax) ' --- обход рекурсии при подмассиве равном 2 элементам
a(imax) = a(jp) ' --- обход рекурсии при подмассиве равном 2 элементам
a(jp) = tmpElm ' --- обход рекурсии при подмассиве равном 2 элементам
End If ' --- обход рекурсии при подмассиве равном 2 элементам
End If ' --- обход рекурсии при подмассиве равном 2 элементам
End if
End Sub


Private Sub CountSort (a As Variant, Optional ByVal minv As Long, Optional ByVal maxv As Long)
REM caption
REM Сортировка одномерного массива целых методом подсчёта
REM in
REM a As Integer - сортируемый массив целых
REM discription
REM Сортирует одномерный массив целых методом подсчёта с динамическим ресайзингом вспомогательного массива.
Dim CA() As Long
Dim cminv As Long
Dim cmaxv As Long
Dim size As Long
Dim l1 As Long
Dim l2 As Long
Dim la As Long
Dim lb As Long
Dim ub As Long
Dim tmpElm As Long
Dim sType As String
If IsMissing(a) Then Exit Sub
If Not(IsArray(a)) Then Exit Sub
If UBound(a,1) >= 0 Then Exit Sub
sType = TypeName(vValue)
sType = UCase(sType)
if sType <> "BYTE()" OR sType <> "INTEGER()" OR sType <> "LONG()" Then Exit Sub
lb = LBound(a)
ub = UBound(a)
size = ub-lb
' определение максимума и минимума
If IsMissing(maxv) OR IsMissing(minv) Then
cminv = a(lb)
cmaxv = a(ub)
If a(lb) > a(ub) Then
cminv = a(ub)
cmaxv = a(lb)
Else
cminv = a(lb)
cmaxv = a(ub)
End if
Else
cminv = minv
cmaxv = maxv
End If
' первый ресайзинг массива
ReDim CA(cminv to cmaxv)
'Начинаем процедуру подсчёта
On Error Goto overindex
For Each tmpElm In a
CA(tmpElm) = CA(tmpElm)+1
Next
la = lb
For l1 = cminv To cmaxv
For l2 = la To la+CA(l1)-1
a(l2) = l1
Next
la = l2
Next
Exit Sub
overindex:
If tmpElm>cmaxv then cmaxv=tmpElm
If tmpElm<cminv then cminv=tmpElm
ReDim Preserve CA(cminv to cmaxv)
Resume
End Sub

Private Sub ShakeSort (a As Variant, Optional ByVal lb As Long, Optional ByVal ub As Long)
REM caption
REM Шейкерная сортировка одномерного массива
REM in
REM a As Variant - сортируемый массив
REM lb As Long - левая граница сортируемого участка массива
REM ub As Long - правая граница сортируемого участка массива
REM discription
REM Сортирует одномерный массив методом шейкерной сортировки. Может сортировать только часть массива от левого элемнта (lb) до правого (ub).
Dim imin As Long
Dim imax As Long
Dim tmpElm As Variant
Dim l As Long

If IsMissing(a) Then Exit Sub
If Not(IsArray(a)) Then Exit Sub
If UBound(a,1) >= 0 Then Exit Sub

If IsMissing(lb) Then
imin = LBound(a)
Else
imin = lb
End If
If IsMissing(ub) Then
imax = UBound(a)
Else
imax = ub
End If

Do While imin<imax
For l = imin+1 To imax
If a(l-1)>a(l) Then
tmpElm = a(l-1)
a(l-1) = a(l)
a(l) = tmpElm
End If
Next
imax = imax - 1
For l = imax-1 To imin Step -1
If a(l+1)<a(l) Then
tmpElm = a(l+1)
a(l+1) = a(l)
a(l) = tmpElm
End If
Next
imin = imin + 1
Loop
End Sub

Есть в ORE. Отдаём ему массив, получаем отсортированный масив. Никаких рекурсий - всё упаковано внутрь процедуры.

Цитата: JohnSUN от 26 июня 2010, 12:45Там чуток придется повозиться при переводе кода с Модулы, с имитацией стека через массив
Там же в ORE класс Стэка:
REM CLS:0:8:0
REM Стэк

Option Compatible
Option ClassModule

REM  указатель на вершину стэка
Private SeekStack As Double REM hide
REM  размер зарезервированного под стэк массива
Private UBaMAS64 As Double REM hide
REM  массив зарезервированный под стэк
Private aMainAarrayStack64() As Variant REM hide

Private Function Size As Double
REM caption
REM Возвращает размер стэка
REM returns
REM Double - размер стэка (количество зарезервированных слов)
Size = SeekStack + 1
End Function

Private Sub Reserve (Optional SizeStack As Double)
REM caption
REM Резервирует память для размещения стэка
REM in
REM SizeStack As Double - количество резервируемых слов
REM discription
REM Резервирует размер стэка и обнуляет его. Если размер не передан - устанавливается размер равный 65 словам. Требуется при начальной инициализации стэка. Начальная инициализация необходима только если предполагается использование метода Put при помещении в стэк первого значения.
If IsMissing(SizeStack) Then SizeStack = 64
UBaMAS64 = SizeStack - 1
ReDim aMainAarrayStack64(SizeStack)
SeekStack = -1
End Sub

Private Function Put (vInVal As Variant) As Variant
REM caption
REM Небезопасное добавление значения в стэк
REM returns
REM Numeric - количество значений в стэке после добавления
REM in
REM vInVal - добавляемое значение
REM raises
REM #OVERFLOW! - Переполнение
REM discription
REM Помещает значение в стэк и возвращает количество значений в стэке в случае удачи.
On Error GoTo StackOverFlow
SeekStack = SeekStack + 1
aMainAarrayStack64(SeekStack) = vInVal
Put = SeekStack + 1
Exit Function
StackOverFlow:
Put = "#OVERFLOW!"
End Function

Private Function protectPut (vInVal As Variant) As Double
REM caption
REM Безопасное добавление значения в стэк
REM returns
REM Numeric - количество значений в стэке после добавления
REM in
REM vInVal - добавляемое значение
REM discription
REM Помещает значение в стэк и возвращает количество значений в стэке. Не может вызвать переполнения стэка, но работает медленнее чем Put.
If UBaMAS64 = 0 Then
UBaMAS64 = 63
ReDim aMainAarrayStack64(63)
SeekStack = -1
End if
SeekStack = SeekStack + 1
If SeekStack > UBaMAS64 Then
UBaMAS64 = UBaMAS64 + 64
ReDim Preserve aMainAarrayStack64(UBaMAS64)
End If
aMainAarrayStack64(SeekStack) = vInVal
protectPut = SeekStack + 1
End Function

Private Function Push As Variant
REM caption
REM Возвращает значение из стэка
REM returns
REM Variant - очередное значение
REM raises
REM #DOWNFLOW! - Опусташения стэка
On Error GoTo Downflow
Push = aMainAarrayStack64(SeekStack)
SeekStack = SeekStack - 1
Exit Function
Downflow:
Push = "#DOWNFLOW!"
End Function

Private Function toArray As Variant
REM caption
REM Возвращает содержимое стэка как массив
REM returns
REM Array - Массив значений стэка
REM raises
REM #DOWNFLOW! - Стэк пуст
REM discription
REM Данный метод не изменяет содержимое стэка
On Error GoTo Downflow
If SeekStack > -1 Then
Dim aContent() As Variant
aContent = aMainAarrayStack64
ReDim Preserve aContent(SeekStack)
toArray = aContent
Exit Function
End If
Downflow:
toArray = "#DOWNFLOW!"
End Function

Private Sub FreeMemory
REM caption
REM Освобождает память зарезервированную под стэк
REM discription
REM Данный метод не изменяет содержимое стэка и не разрушает его. Не рекомендуется при использовании Put для помещения значений в стэк, так как не даёт возможности отслеживать доступный размер стэка после применения.
If SeekStack < 31 Then
UBaMAS64 = 63
ReDim Preserve aMainAarrayStack64(63)
ElseIf SeekStack < UBaMAS64\2 Then
UBaMAS64 = SeekStack*2
If UBaMAS64 < 64 Then UBaMAS64 = 64
ReDim Preserve aMainAarrayStack64(UBaMAS64)
End If
End Sub


Свобода информации - свобода личности!

JohnSUN

#18
Ну, я, конечно, могу ошибаться, но!.. ;D
Если в параметрах Calc'а, в Вычислениях не установлена галка на Итерации в циклических ссылках - а по умолчанию она сброшена - то попытка бэйсика "обратиться к себе" воспринимается (обрабатывается) как зацикленная ссылка... Во всяком случае я неоднократно плясал на этих граблях в прошлых версиях.

UPD А, понял... Недоразумение из-за недоговоренности...  ;D
Я обычно оформляю код функциями, которые вызываю с листа - просто чтобы не возиться с отдельными кнопками для вызова процедур или слушателями событий. Вот они-то и прекращают выполнение с ошибкой, если в стеке вызовов повторно появляется знакомое имя.

Нет, ЧИСТАЯ процедура запущенная отдельно безусловно никаких ошибок не вызовет, отработает до конца
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

dr.Faust

Цитата: dr.Faust от 26 июня 2010, 12:52Класс, в том числе и с КвикСортом
Оу - там ещё и сортировка подсчётом есть...


Цитата: JohnSUN от 26 июня 2010, 12:57Если в параметрах Calc'а, в Вычислениях не установлена галка на Итерации в циклических ссылках - а по умолчанию она сброшена - то попытка бэйсика "обратиться к себе" воспринимается (обрабатывается) как зацикленная ссылка... Во всяком случае я неоднократно плясал на этих граблях в прошлых версиях.
Только когда вызывается та же функция, что была вызвана как функция Calc, но не другие подфункции/подпроцедуры вызванные из неё. Вроде так.
Свобода информации - свобода личности!

dr.Faust

Цитата: JohnSUN от 26 июня 2010, 12:57Я обычно оформляю код функциями, которые вызываю с листа - просто чтобы не возиться с отдельными кнопками для вызова процедур или слушателями событий.
Ну так надо выдернуть процедуру из этой функции - вычислить всё в ней, и вернуть назад...
Свобода информации - свобода личности!

JohnSUN

Раньше (в старых версиях) не получалось (это я про вызов процедуры вне функции) - стек вызовов строился от текущей функции и накапливал все вызовы... Хлоп! - такое имя уже было: получи ошибку... Давно не проверял, если исправлено уж - то УРРРАААА!!!
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

dr.Faust

Цитата: JohnSUN от 26 июня 2010, 13:21Давно не проверял, если исправлено уж - то УРРРАААА!!!
Таки пофиксили в полном объёме.

[вложение удалено Администратором]
Свобода информации - свобода личности!