Массивы. Обьявление массивов. Сортировка массивов

@БурундукЪ · Регистрация: 17.02.2009

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

Массивы.

Массивы, друзья мои, очень простая и крайне необходимая штука. Простой пример: ты считал из директории 50 имен файлов и тебе необходимо как-то поместить их в памяти, что-бы потом с ними работать. Без использования массива, ты должен объявить пятьдесят переменных и в каждую записать имя файла. Это безумие. Но еще большее безумие потом работать с этими переменными, пытаясь найти в них нужные нужные тебе данные. Иное дело массив. Имея его (в хорошем смысле), можно под одним именем запомнить все твои пятьдесят имен файлов и перебирать их сколько угодно, в любом цикле, меняя лишь индекс члена массива. Т.е., другими словами,

Массив - это сколько угодно значений, объединенных одним именем.

Массив, прежде чем использовать, надо объявить. Объявляется он совершенно также как и переменная. Если ты объявишь его локально в процедуре (здесь можно использовать ключевое слово Static), то он будет доступен только в этой процедуре и нигде больше, если в разделе (General)-(Daclarations) формы (c оператором Dim) - то во всей форме, а если тебе нужно объявить его глобально, так, чтобы он был доступен всему проекту, то в стандартном модуле с ключевым словом Public.

Кроме того , массивы бывают статическими и динамическими.

Статические массивы.

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

Visual Basic

1	Dim Chislo(9) As Long

Что здесь важно.
Dim - оператор, который точно также, как и при объявлении переменной, объявляет массив и выделяет для нее память.
Chislo - ну это просто имя, придумывается также как и для переменной и отвечает тем же требованиям.
(9) - количество элементов в массиве - их 10. Почему так. Дело в том, что элементы массива нумеруются с нуля, а не с единицы, поэтому у нас десять элементов массива c номерами 0, 1, 2, 3, 4, 5, 6, 7, 8 и 9. Если для каких-то целей такой порядок тебя не устраивает, то используется оператор Option Base 1, который прописывается в разделе Declarations и привязывает первый элемент ВСЕХ, повторяю ВСЕХ, массивов в программе к единице.
As Long - определение типа данных массива так же как тип обычной переменной. Почти всегда все элементы массива имеют один и тот же тип ( в данном случае длинное число Long). На крайняк, если это не так, или если ты не знаешь какого типа будут данные, можно задать тип Variant, но это нежелательно из-за того, что это занимает значительный объем памяти, особенно если массив большой.
Размерность - ее так сразу не заметно, но она здесь присутствует и равна единице, потому, что у на одна циферка (девятка), т.е. наш массив является одномерным - по сути список значений.

Теперь создадим массив для хранения результатов, ну скажем таблицы умножения на 8. Поскольку на ноль умножать бесперспективно, привязываем первый элемент массива к единице и объявляем переменную x для организации цикла For...Next.

Visual Basic

Option Explicit
Option Base 1
Dim Chislo(10) As Long
'так как мы используем оператор Option Base, то элементы массива нумеруются с единицы
Dim x As Long

Положим на форму Text1 с установленными свойствами .MultiLine в True, а .ScrollBars - в 2-Вертикаль, а также кнопку Command1. В процедуре Form_Load напишем цикл, который будет присваивать каждому элементу массива значение, соответствующее его номеру, умноженному на 8.

Visual Basic

Private Sub Form_Load()
Text1.Text = ""
For x = 1 To 10
Chislo(x) = x * 8
Next x
End Sub

Как видите, в цикле мы вместо номера элемента просто используем значение x, и таким образом перебираются все элементы массива. Теперь мы выведем значения элементов массива в Text1 в процедуре Command1.

Visual Basic

Private Sub Command1_Click()
For x = 1 To 10
Text1.Text = Text1.Text & Chislo(x) & vbCrLf
Next x
End Sub

Таким образом наш одномерный массив представляет собой аналог таблицы с одной строчкой:

Массивы. Обьявление массивов. Сортировка массивов

Теперь переделаем его в двухмерный массив, чтобы в еще одну строчку записать множитель, на который умножается число 8. Переделаем наш код на такой:

Visual Basic

Option Explicit
Option Base 1
Dim Chislo(10, 2) As Long
Dim x As Long
 
Private Sub Form_Load()
Text1.Text = ""
For x = 1 To 10
Chislo(x, 1) = x
Chislo(x, 2) = x * 8
Next x
 
Private Sub Command1_Click()
For x = 1 To 10
Text1.Text = Text1.Text & "8 x " & Chislo(x, 1) & " = " & Chislo(x, 2) & vbCrLf
Next x
End Sub

И наш массив будет представлять собой следующее

таким образом элемент массива Chislo (7,2) будет иметь значение 56.

Обратите внимание, что размерность массива определяет колиство циферек в объявлении. Массив Chislo (10,5) - тоже двухмерный, только строк в табличке было-бы не две, а пять. А объявление трехмерного массива выглядело бы так

Dim(10,5,2).Такую трехмерную таблицу нарисовать мне затруднительно. В принципе VB поддерживает до 64 размерностей массива, но это в голове трудно укладывается.

Все, как видите очень просто. Однако статические массивы используются довольно редко. Чаше мы не знаем сколько данных мы будем иметь и потом ведь хочется дописать при необходимости в массив новые данные. Для этого существуют

Динамические массивы.

Часто возникает ситуация, когда мы не знаем заранее, сколько элементов массива мы будем использовать заранее. Поэтому массив объявляется без размерности, например

Visual Basic

1	Dim Mass () as String

Но, перед его непосредственным использованием, его надо переобъявить c указанием размерности. Делается это с помощью оператора Redim.

Visual Basic

1	Redim Mass (5) as String

Вообще-то, у нас два пути использования динамического массива.

Первый путь, это года мы узнаем (просчитываем) , сколько элементов массива нам нужно, и после этого объявляем массив небходимого нам размера. Однако мне это путь не очень нравится, поскольку, нам приходится задавать два цикла: один - для просчета необходимого количества элементов, второй - для собственно присваивания массиву значений переменных.

Второй путь, это когда мы в одном цикле при нахождении каждого нового данного переобъявляем массив с увеличением количества его элементов. Но этот способ загружает компьютер и может занимать много времени на обработку, особенно если создается большой массив. Происходит это из-за перераспределения элементов массива в памяти всякий раз при его переобъявлении и добавлении нового члена. Но именно такой способ мы применим при разработке программки Scanfiles, которая будет сканировать файлы в выбранной директории, сортировать их по-возрастанию и выводить в Text1. Хочу сразу заметить, что при переобъявлении массива все записанные в него данные стираются - массив обнуляется. Чтобы этого не происходило, надо использовать ключевое слово Peserve:

Visual Basic

1	Redim Preserve Mass (5) as String

Идем дальше. Поместим на форму объекты Dir1 и Text1. Начнем писать код. Обратите внимание, что процедуры Form_Load у нас не будет, так как под это событие обрабатывать нам нечего. Ну-с, фигачим

Visual Basic

Option Explicit
'Установим начальную нумерацию массива с единицы, сейчас так удобнее
Option Base 1
'объявим переменные
Dim OurDir As String 'для директории, где будем искать файлы
Dim FileName As String 'для имен находимых файлов
Dim X As Long 'просто для цикла
'и, наконец, наш динамический массив, как строковый
Dim Files() As String

Кроме того, поскольку одни имена - это уж совсем скучно, то мы еще во вторую размерность массива выведем атрибуты файла. Атрибуты, это когда по файлу шлепаешь правой кнопкой мыши и в выпавшем меню выбираешь "Свойства". Тогда снизу окна этих свойств можно увидеть галочки рядом с загадочными словами "Только чтение", "Скрытый" и "Архивный". Именно эти свойства можно устанавливать или получать с помощью оператора SetAttr и функции GetAttr. Весь геморрой в том, что этот атрибут представляет из себя число, получаемое из суммы значений атрибутов, приведенных в таблице ниже, и чтобы понять, какой атрибут все-таки у файла, нужно "с помощью оператора And выполнить поразрядное сравнение значения". Друзья мои. Это цитату из Help5 я привел для того, чтобы можно было почувствовать разницу между "академическим" и "вольным" изложением проблемы. Короче, привожу таблицу этих атрибутов:

Из всей этой дребедни нам нужны три константы: vbArchive, vbReadOnly и vbHidden для этого самого "поразрядного сравнения". Делается это так:

Чтобы узнать, только для чтения ли этот файл:
Переменная = GetAttr("полный путь к файлу") And vbReadOnly
Если в Переменной не ноль, то файл - только для чтения. Аналогично для других констант.
Чтобы установить аттрибут, например "Архивный" для файла:
SetAttr "C:\Andrey\index.htm", vbReadOnly
при этом уже установленные атрибуты файла сбрасываются. Если надо установить атрибуты "только для чтения" и "архивный":
SetAttr "C:\Andrey\index.htm", vbReadOnly +vbArchive
Все просто, а по сути - издевательство. Про атрибуты - все. Более интересные данные о файлах мы получим, когда начнем использовать FSO. Но об этом не сегодня.
Итак, для хранения атрибута (на основании "поразрядного сравнения") продолжаем объявлять переменные (еще две)

Visual Basic

1 2	Dim Attr As Long 'числовая, для атрибута файла Dim AttributFile As String 'строковая, для записи атрибута в виде слов

Напишем маленькую процедурку для Dir1 на событие Change. Дело в том, что событие Change наступает при двойном клике, а я и хочу, чтобы директория для поиска файлов устанавливалась по двойному клику. В этой процедурке мы очистим Text1 и обнулим переменные, ну и главное, запишем в переменную OurDir полный путь к директории, после чего перейдем к другой поцедуре - ScanDir, где собственно и будем искать файлы и записывать их имена и атрибуты в наш массив Files.

Visual Basic

Private Sub Dir1_Change()
Text1.Text = ""
FileName = ""
X = 0
OurDir = Dir1.Path
ScanDir 'переходим к процедуре сканирования файлов
End Sub

Далее в процедуре ScanDir все, с учетом комментариев, понятно:

Visual Basic

Private Sub ScanDir()
FileName = Dir(OurDir & "\*.*", 0) 'присваиваем переменной значение функции Dir для всех файлов
ReDim Files(2, 1) 'переобъявляем массив с минимальной размерностью, иначе может возникать ошибка
Do While FileName <> "" 'запускаем цикл, до тех пор, пока Dir не вернет пустую строку
X = X + 1 'счетчик элементов массива
ReDim Preserve Files(2, X) 'переобъявляем массив по счетчику, сохраняя уже имеющиеся в нем данные
AttributFile = "" 'обнуляем переменные
Attr = 0
'проверяем файл на атрибут архивный
Attr = GetAttr(OurDir & "\" & FileName) And vbArchive
If Attr > 0 Then AttributFile = AttributFile & " Архивный"
'проверяем файл на атрибут только для чтения
Attr = GetAttr(OurDir & "\" & FileName) And vbReadOnly
If Attr > 0 Then AttributFile = AttributFile & " Только чтение"
'проверяем файл на атрибут скрытый для порядка, Бейсик все равно не видит такие файлы
Attr = GetAttr(OurDir & "\" & FileName) And vbHidden
If Attr > 0 Then AttributFile = AttributFile & " Скрытый"
 
Files(1, X) = FileName 'пишем в массив имя файла
Files(2, X) = AttributFile 'пишем в массив атрибут файла
FileName = Dir() 'запускаем функцию Dir без атрибутов
Loop 'и так в цикле, пока файлы в директории не закончатся
 
If X > 0 Then
Sort ' если хоть один файл найден,
'отправляемся к процедуре сортировки
Else
Text1.Text = "Файлов не найдено" 'в противном случае выводим сообщение.
End If
End Sub

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

Поскольку количество элементов нашего массива меняется, а для сортировки его с помощью циклов For...Next нам надо точно знать минимальный (нижняя граница) и максимальный (верхняя граница) доступные значения индекса массива, то я использую функции LBound для определения минимального индекса и UBound для определения максимального индекса указанной размерности. Синтаксис их такой

Переменная=LBound(Massive,1) 'возвращает в Переменную минимальный индекс массива Massive по размерности 1.
Переменная=UBound(Massive,1) 'возвращает в Переменную максимальный индекс массива Massive по размерности 1.

Надо сказать, что размерность - не обязательный параметр и по-умолчанию принимается за единицу.
Теперь перейдем к сортировке массива:

Visual Basic

Private Sub Sort() 'процедура сортировки
Dim K As Long
Dim N As Long
Dim y As Long 'просто для цикла For...Next
Dim Peremen As String 'для временного храненения из массива имени файла
Dim Peremen2 As String 'и атрибута файла
Dim NomerPerem As String
Dim NomerPerem2 As String
'сортировка массива
K = LBound(Files, 2) 'присваиваем переменной К начальное значение массива - 1 (нижняя граница)
For y = LBound(Files, 2) To UBound(Files, 2) 'просматриваем все строки массива с нижней до верхней границы
Peremen = Files(1, y) 'присваиваем каждую строку в переменные
Peremen2 = Files(2, y)
'вложенный цикл
For N = y To UBound(Files, 2) 'просматриваем строки массива, начиная с той,
'значения которой храняться в переменных Peremen и Peremen2
 
If Files(1, N) < Peremen Then 'если значение в массиве меньше, чем в переменной
Peremen = Files(1, N) 'то присваиваем переменным Peremen и Peremen2 новые, меньшие значения
Peremen2 = Files(2, N)
K = N 'присваиваем номер найденного элемента массива переменной K
End If
Next N
'конец вложенного цикла
NomerPerem = Files(1, y) 'сохраняем в переменных старые значения строки массива
NomerPerem2 = Files(2, y)
Files(1, y) = Peremen ' и присваиваем этой строке массива новые
Files(2, y) = Peremen2
If K > 0 Then 'если K не ноль,
Files(1, K) = NomerPerem 'то строке К присваиваем старые значения из строки y
Files(2, K) = NomerPerem2
End If
Peremen = "" 'обнуляем переменные
Peremen2 = ""
K = 0
Next y
'конец сортировки
'просто выводим в Text1 отсортированные значения массива
For X = 1 To UBound(Files, 2)
Text1.Text = Text1.Text & Files(1, X) & Files(2, X) & vbCrLf
Next X
End Sub

Исходник программы можно, как всегда, скачать вверху страницы.

Можно ли присвоить один массив другому не по отдельному элементу (в цикле), а сразу.

Присвоение массивов.
Visual Basic 6.0 и версии выше дают возможность проводить операции присваивания с массивами точно также, как с переменными. Теперь нет необходимости создавать цикл For...Next для присваивания одного массива другому по каждому элементу. Достаточно написать такой оператор

Visual Basic

1	NewMassive=OldMassive

и содержимое массива OldMassive присвоится массиву NewMassive.
Однако при этом следут учитывать, что для исключинения ошибок при таком присвоении, желательно соблюдать одинаковую размерность и тип массивов. Хотя при присвоении динамического массива динамическому массиву, массив в левой части оператора изменяется, как бы подстраивается под оператор в правой части. Однако при работе со статическими массивами возможна ошибка компиляции. Кроме того при присвоении, например массива типа Long типу Integer может возникнуть ошибка переполнения (Owerflow). В программе операция присвоения может выглядеть приблизиельно так (на форме должны быть кнопка Command1 и текстбокс Text1):

Visual Basic

Option Explicit
Dim OldMassive() As Long
Dim NewMassive() As Long
 
Private Sub Command1_Click()
Dim x As Long
 
For x = 0 To 999 'просто заполнение массива цифрами
ReDim Preserve OldMassive(x)
OldMassive(x) = x
Next x
 
NewMassive = OldMassive 'присоение массивов
 
For x = 0 To UBound(NewMassive) ' считывание нового массива в Text1
Text1.Text = Text1.Text & NewMassive(x) & vbCrLf
Next x
End Sub

Я думаю, особых комментариев здесь не требуется.

http://books.kulichki.com/data... age_10.htm

@БурундукЪ · 05.12.2009, 18:29 **[ТС]**

Процедура для сортировки массива методом пузырька

Visual Basic

'Процедура для сортировки массива методом пузырька
'
'Входные параметры:
'    Arr -   сортируемый массив.
'            Нумерация элементов от 0 до N-1
'    N   -   размер массива
'
'Выходные параметры:
'    Arr -   массив, упорядоченный по возрастанию.
'            Нумерация элементов от 0 до N-1
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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

Процедура для сортировки массива методом Шелла

Visual Basic

'Процедура для сортировки массива методом Шелла
'
'Входные параметры:
'    Arr -   сортируемый массив.
'            Нумерация элементов от 0 до N-1
'    N   -   размер массива
'
'Выходные параметры:
'    Arr -   массив, упорядоченный по возрастанию.
'            Нумерация элементов от 0 до N-1
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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

Процедура для сортировки массива методом выборки

Visual Basic

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

Процедура для сортировки массива методом вставок

Visual Basic

'Процедура для сортировки массива методом вставок
'
'Входные параметры:
'    Arr -   сортируемый массив.
'            Нумерация элементов от 0 до N-1
'    N   -   размер массива
'
'Выходные параметры:
'    Arr -   массив, упорядоченный по возрастанию.
'            Нумерация элементов от 0 до N-1
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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

Процедура для сортировки массива методом двоичных вставок

Visual Basic

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

Процедура для упорядочивания массива пирамидальной сортировкой

Visual Basic

'Процедура для упорядочивания массива пирамидальной сортировкой
'
'Входные параметры:
'    Arr -   сортируемый массив.
'            Нумерация элементов от 0 до N-1
'    N   -   размер массива
'
'Выходные параметры:
'    Arr -   массив, упорядоченный по возрастанию.
'            Нумерация элементов от 0 до N-1
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
 
Private Sub TestHeapSort()
    Dim Pass As Long
    Dim PassCount As Long
    Dim WasErrors As Boolean
    Dim I As Long
    Dim J As Long
    Dim N As Long
    Dim Tmp As Double
    Dim A() As Double
    Dim T() As Double
 
    WasErrors = False
    PassCount = 1000#
    For Pass=1# To PassCount Step 1
        N = 1#+RandomInteger(50#)
        ReDim A(0# To N-1#)
        ReDim T(0# To N-1#)
        For I=0# To N-1# Step 1
            A(I) = Rnd()
            T(I) = A(I)
        Next I
        Call HeapSort(A, N)
        For i=0# To N-1# Step 1
            For j=0# To n-2#-i Step 1
                If T(j)>T(j+1#) then
                    Tmp = T(j)
                    T(j) = T(j+1#)
                    T(j+1#) = Tmp
                End If
            Next j
        Next i
        For I=0# To N-1# Step 1
            If A(I)<>T(I) then
                WasErrors = True
            End If
        Next I
        If WasErrors then
            Exit For
        End If
    Next Pass
    If WasErrors then
        ConsoleOutputString  "TestHeapSort failed!" &  vbNewLine
    Else
        ConsoleOutputString  "TestHeapSort passed" &  vbNewLine
    End If
End Sub

Процедура для сортировки массива методом фон Неймана (слияний)

Visual Basic

'Процедура для сортировки массива методом фон Неймана (слияний)
'
'Входные параметры:
'    Arr -   сортируемый массив.
'            Нумерация элементов от 0 до N-1
'    N   -   размер массива
'
'Выходные параметры:
'    Arr -   массив, упорядоченный по возрастанию.
'            Нумерация элементов от 0 до N-1
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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

Функция для поиска k-ого по величине элемента массива

Visual Basic

'Функция для поиска k-ого по величине элемента массива.
'Параметры:
'    *M - массив элементов с индексами от 0 до N-1
'    *N - число элементов
'    *K - номер искомого элемента
'Результат:
'    *Значение K-ого по величине элемента.   K  принимает
'     значения в диапазоне от 0 до N-1, где нулю соответ-
'     ствует наименьший элемент, N-1 - наибольший.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function KthElement(ByRef MArr_() As Double, _
         ByVal N As Long, _
         ByVal K As Long) As Double
    Dim Result As Double
    Dim MArr() As Double
    Dim I As Long
    Dim J As Long
    Dim L As Long
    Dim NM As Long
    Dim MM As Long
    Dim KM As Long
    Dim med As Double
    Dim Tmp As Double
    Dim Tmp2 As Double
    Dim LArr() As Double
    Dim MergeLen As Long
    MArr = MArr_
 
    ReDim LArr(0# To N-1#)
    K = K+1#
    Do While n>5#
        i = 1#
        Do
            LArr(i-1#) = MArr(i-1#)
            i = i+1#
        Loop Until  Not i<=n
        nm = n
        Do While nm>5#
            mm = nm\5#
            i = 1#
            Do
                km = (i-1#)*5#
                j = 1#
                Do
                    l = 1#
                    Do
                        If LArr(km+l-1#)>Larr(km+l-1#) then
                            Tmp = LArr(km+l-1#)
                            LArr(km+l-1#) = LArr(km+l)
                            LArr(km+l) = Tmp
                        End If
                        l = l+1#
                    Loop Until  Not l<=5#-j
                    j = j+1#
                Loop Until  Not j<=5#
                LArr(i-1#) = LArr(km+2#)
                i = i+1#
            Loop Until  Not i<=mm
            km = mm*5#
            nm = nm-km
            If nm>0# then
                mm = mm+1#
                If nm>1# then
                    j = 1#
                    Do
                        l = 1#
                        Do
                            If LArr(km+l-1#)>LArr(km+l) then
                                Tmp = LArr(km+l-1#)
                                LArr(km+l-1#) = LArr(km+l)
                                LArr(km+l) = Tmp
                            End If
                            l = l+1#
                        Loop Until  Not l<=nm-j
                        j = j+1#
                    Loop Until  Not j<=nm
                End If
                LArr(mm-1#) = LArr(km)
            End If
            nm = mm
        Loop
        If nm<>1# then
            j = 1#
            Do
                l = 1#
                Do
                    If LArr(l-1#)>LArr(l) then
                        Tmp = LArr(l-1#)
                        LArr(l-1#) = LArr(l)
                        LArr(l) = Tmp
                    End If
                    l = l+1#
                Loop Until  Not l<=nm-j
                j = j+1#
            Loop Until  Not j<=nm
            If nm>=3# then
                med = LArr(1#)
            Else
                med = LArr(0#)
            End If
        Else
            med = LArr(0#)
        End If
        i = 1#
        j = n
        Do While i<>j
            If MArr(i-1#)>med then
                Do While MArr(j-1#)>med And i<>j
                    j = j-1#
                Loop
                If i<>j then
                    Tmp2 = MArr(i-1#)
                    MArr(i-1#) = MArr(j-1#)
                    MArr(j-1#) = Tmp2
                    i = i+1#
                End If
            Else
                i = i+1#
            End If
        Loop
        If k>=j then
            i = j
            Do
                MArr(i-j) = MArr(i-1#)
                i = i+1#
            Loop Until  Not i<=n
            n = n-j+1#
            k = k-j+1#
        Else
            n = j-1#
        End If
    Loop
    If n<>1# then
        i = 1#
        Do
            j = 1#
            Do
                If MArr(j-1#)>MArr(j) then
                    Tmp2 = MArr(j-1#)
                    MArr(j-1#) = MArr(j)
                    MArr(j) = Tmp2
                End If
                j = j+1#
            Loop Until  Not j<=n-i
            i = i+1#
        Loop Until  Not i<=n
        Result = MArr(k-1#)
    Else
        Result = MArr(0#)
    End If
 
    KthElement = Result
End Function

Функция для поиска наименьшего элемента

Visual Basic

'Функция для поиска наименьшего элемента.
'Принимает:
'    *массив значений a с индексами элементов от 0 до N-1
'    *число элементов N
'Возвращает:
'    *номер наименьшего элемента
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function FindLeastElement(ByRef a() As Double, ByRef N As Long) As Long
    Dim Result As Long
    Dim I As Long
 
    result = 0#
    For I=1# To N-1# Step 1
        If a(result)>a(i) then
            result = i
        End If
    Next I
 
    FindLeastElement = Result
End Function

Поиск в упорядоченной последовательности первого элемента, не меньшего, чем T

Visual Basic

'Поиск в упорядоченной последовательности первого элемента, не меньшего, чем T.
'
'Параметры:
'    A - упорядоченный по возрастанию массив элементов с
'        индексами от 0 до N-1
'    N - число элементов в массиве
'    T - искомый элемент
'
'Результат:
'    Индекс самого первого элемента, не меньшего T. В случае,
'если таких элементов в массиве нет, возвращается N.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function LowerBound(ByRef A() As Double, _
         ByRef N As Long, _
         ByRef T As Double) As Long
    Dim Result As Long
    Dim L As Long
    Dim Half As Long
    Dim First As Long
    Dim Middle As Long
 
    L = N
    First = 0#
    Do While L>0#
        Half = L\2#
        Middle = First+Half
        If A(Middle)<T then
            First = Middle+1#
            L = L-Half-1#
        Else
            L = Half
        End If
    Loop
    Result = First
 
    LowerBound = Result
End Function
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Поиск в упорядоченной последовательности первого элемента,
'большего, чем T.
'
'Параметры:
'    A - упорядоченный по возрастанию массив элементов с
'        индексами от 0 до N-1
'    N - число элементов в массиве
'    T - искомый элемент
'
'Результат:
'    Индекс первого элемента, большего T. В случае,
'если таких элементов в массиве нет, возвращается N.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function UpperBound(ByRef A() As Double, _
         ByRef N As Long, _
         ByRef T As Double) As Long
    Dim Result As Long
    Dim L As Long
    Dim Half As Long
    Dim First As Long
    Dim Middle As Long
 
    L = N
    First = 0#
    Do While L>0#
        Half = L\2#
        Middle = First+Half
        If T<A(Middle) then
            L = Half
        Else
            First = Middle+1#
            L = L-Half-1#
        End If
    Loop
    Result = First
 
    UpperBound = Result
End Function

источник: http://alglib.sources.ru/