При сортировке включениями из неупорядоченной последовательности элементов поочередно выбирается каждый элемент, сравнивается с предыдущим (уже упорядоченным) списком и помещается на соответствующее место в последнем.
(См. Пример 3.)
Сортировка бинарными включениями
По количеству сравнений алгоритм сортировки бинарными включениями лучше, чем рассмотренные выше алгоритмы. Различными авторами предпринимались попытки доказательства оптимальности алгоритма сортировки бинарными включениями и даже печатно сообщалось о якобы найденном доказательстве. Позднее выяснилось, что и этот алгоритм не оптимален, т.к. он требует восемь сравнений для упорядочивания пяти чисел, а на самом деле достаточно семи сравнений.
(См. Пример 4.)
Шейкер-сортировка
(См. Пример 5.)
ДЕМОНСТРАЦИОННЫЕ ПРИМЕРЫ
Пример 1
' Имя файла Sort_Bubble.vbs
' Программа демонстрирует сортировку вектора по неубыванию методом обмена
' или (другое название) пузырьком.
Option Explicit
Dim sorted, i, j, s, B, x
B=Array (5, 3, 2, 1, 0, -1) ' вектор, который должен быть отсортирован пузырьком
sorted=false ' логическая переменная
While not sorted ' пока вектор не отсортирован...
sorted=true
For i=0 to 4
If B(i+1)<B(i) Then ' если левый элемент больше правого, то поменять их местами
x=B(i)
B(i)=B(i+1)
B(i+1)=x
For j=0 to 5 ' в переменную s записывается изменённый вектор
s=s&B(j)&" "
Next
s=s&VbCrLf
Sorted=false
End If
Next
Wend
MsgBox "Задача:"&vbCrLf&_
"Отсортировать вектор (5, 3, 2, 1, 0, -1)"&vbCrLf&vbCrLf&_
"Пошаговая сортировка:"&vbCrLf&_
s&vbCrLf,vbInformation, "Сортировка пузырьком:"
Пример 2
' Имя файла Sort_Choice.vbs
' Программа демонстрирует сортировку вектора по неубыванию методом простого
' выбора (первый способ).
Option Explicit
Dim i, j, s, B, x, k, m
B=Array (5, 3, 2, 1, 0, -1) ' вектор, который должен быть отсортирован
' Начало алгоритма сортировки
For i=0 to 4
k=i : x=B(i)
For j=i+1 to 5
If B(j)<x Then
k=j
x=B(j)
End If
B(k)=B(i)
B(i)=x
For m=0 to 5
s=s&B(m)&" " ' в переменную s записывается изменённый вектор
Next
s=s&VbCrLf
Next
Next
' Конец алгоритма сортировки
MsgBox "Задача:"&vbCrLf&_
"Отсортировать вектор (5, 3, 2, 1, 0, -1)"&vbCrLf&vbCrLf&_
"Пошаговая сортировка:"&vbCrLf&_
s&vbCrLf,vbInformation, "Сортировка простым выбором (1 сп):"
Пример 3
' Имя файла Sort_Insert.vbs
' Программа демонстрирует сортировку вектора по неубыванию методом простых
' включений.
Option Explicit
Dim i, j, s, x, k, m
Dim B (6) ' вектор, который должен быть отсортирован
B(1)=5
B(2)=3
B(3)=10
B(4)=1
B(5)=0
B(6)=-1
' Начало алгоритма сортировки
For i=1 to 6
x=B(i) : B(0)=x : j=i-1
While x<B(j)
B(j+1)=B(j) : j=j-1
Wend
B(j+1)=x
For m=0 to 6
s=s&B(m)&" " ' в переменную s записывается изменённый вектор
Next
s=s&VbCrLf
Next
' Конец алгоритма сортировки
MsgBox "Задача:"&vbCrLf&_
"Отсортировать вектор (5, 3, 10, 1, 0, -1)"&vbCrLf&vbCrLf&_
"Пошаговая сортировка:"&vbCrLf&_
s&vbCrLf,vbInformation, "Сортировка простыми включениями:"
Пример 4
' Имя файла Sort_Bin_Insert.vbs
' Программа демонстрирует сортировку бинарными включениями
Option Explicit
const N=8
dim Arr()
redim Arr(N) 'наш массив
dim i 'счетчик
randomize
For i=1 To N
arr(i)=Cint(10*rnd(1))
next
dim s
s=""
For i=1 To N
s=s+CStr(i)+" --> "+Cstr(arr(i))+";"+vbcrlf
next
dim x,j,l,r,m
' Начало алгоритма сортировки
For i=2 to N
x=Cint(arr(i)): l=1: r=Cint(i-1)
While Cint(l)<=Cint(r)
m=Cint(l+r)\2
if CInt(x)<arr(m) then
r=m-1
else
l=m+1
end if
Wend
j=i-1
While Cint(j)>=Cint(l)
arr(j+1)=arr(j)
j=j-1
Wend
arr(l)=x
Next
' Окончание алгоритма сортировки
dim s1
s1=""
For i=1 To N
s1=s1+CStr(i)+" --> "+Cstr(arr(i))+";"+vbcrlf
next
msgbox "Неотсортированный массив:"&vbCrLf&_
s&vbcrlf&vbcrlf&"Отсортированный:"&vbCrLf&_
s1,0,"Сортировка бинарными включениями:"
Пример 5
' Имя файла Shake_Sort.vbs
' Программа демонстрирует Шейкер-сортировку
Option Explicit
const N=8
dim a()
redim a(N)
dim x,i,j,k,l,r
randomize
For i=1 To N
a(i)=Cint(10*rnd(1))
next
dim s
s=""
For i=1 To N
s=s+CStr(i)+" --> "+Cstr(a(i))+";"+vbcrlf
next
l=2: r=N: k=N
DO
j=r
While Cint(j)>=Cint(l)
If Cint(a(j-1))>Cint(a(j)) Then
x=a(j-1)
a(j-1)=a(j)
a(j)=x
k=j
End If
j=j-1
Wend
l=k+1
For j=l to r
If CInt(a(j-1))>Cint(a(j)) Then
x=a(j-1)
a(j-1)=a(j)
a(j)=x
k=j
End If
Next
r=k-1
LOOP UNTIL Cint(l)>Cint(r)
dim s1
s1=""
For i=1 To N
s1=s1+CStr(i)+" --> "+Cstr(a(i))+";"+vbcrlf
Next
MsgBox "Неотсортированный массив:"&vbCrLf&_
s&vbcrlf&vbcrlf&"Отсортированный:"&vbCrLf&_
s1,0,"Сортировка массива по Шейкеру:"
Пример 6
' Имя файла Find_1.vbs
' Линейный поиск наименьшего индекса элемента с заданным значением
' в "случайном" массиве.
Option Explicit
Dim i, s, x, Q
Const n=6
Dim B (6)
' Заполнение одномерного массива случайными числами
For i=0 to n
Randomize
B(i)=Fix(Rnd(1)*20)
s=s&B(i)&" "
Next
s=s&vbCrLf
' Начало алгоритма поиска
x=InputBox("Введите искомый элемент: ","Окно ввода:", 5)
i=0
Do
i=i+1 : Q=CInt(B(i))=CInt(x)
Loop Until (Q or (i=n))
If Q Then
MsgBox "Массив: "&s&vbCrLf&_
"Элемент "&x&" найден в массиве!"&vbCrLf&_
"Его минимальный индекс в массиве: "&i
Else MsgBox "Массив: "&s&vbCrLf&_
"Элемент "&x&" не найден в массиве!"
End If
Пример 7
' Имя файла Find_2.vbs
' Линейный поиск с "барьером" наименьшего индекса элемента с заданным значением
' в "случайном" массиве.
Option Explicit
Dim i, s, x, Q
Const n=6
Dim B (6)
' Заполнение одномерного массива случайными числами
For i=0 to n-1
Randomize
B(i)=Fix(Rnd(1)*20)
s=s&B(i)&" "
Next
s=s&vbCrLf
' Начало алгоритма поиска
x=InputBox("Введите искомый элемент: ","Окно ввода:", 5)
i=-1 : B(n)=x
Do
i=i+1
Loop Until CInt(B(i))=Cint(B(n))
If i<>n Then
MsgBox "Массив: "&s&vbCrLf&_
"Элемент "&x&" найден в массиве!"&vbCrLf&_
"Его минимальный индекс в массиве: "&i
Else MsgBox "Массив: "&s&vbCrLf&_
"Элемент "&x&" не найден в массиве!"
End If
Пример 8
' Имя файла Find_3.vbs
' Бинарный поиск индекса заданного элемента
' одномерного "случайного" числового массива, строго
' упорядоченного по возрастанию (нерекурсивный вариант).
' Число требуемых сравнений в методе бинарного поиска в среднем значительно
' меньше, чем при линейном поиске, а точнее говоря,
' не более чем логарифм n по основанию два вместо n в программе Find_2.vbs
Option Explicit
Dim i, j, s, x, Q, k
Const n=8
Dim B (8)
For i=0 to n
B(i)=CDbl(InputBox("Введите "&i&"-й элемент одномерного массива",_
"Ввод строго возрастающего вектора A:", i))
s=s&B(i)&" "
Next
s=s&vbCrLf
' Начало алгоритма поиска
x=CDbl(InputBox("Введите искомый элемент: ","Окно ввода:", 5))
i=0 : Q=False : j=n
Do
k=(i+j)\2
If B(k)=x Then
Q=True
Else
If B(k)<x Then
i=k+1
Else j=k-1
End If
End If
Loop Until Q or (i>j)
If Q Then
MsgBox "Массив: "&s&vbCrLf&_
"Элемент "&x&" найден в массиве!"&vbCrLf&_
"Его минимальный индекс в массиве: "&i
Else MsgBox "Массив: "&s&vbCrLf&_
"Элемент "&x&" не найден в массиве!"
End If
Пример 9
' Имя файла Find_4.vbs
' Бинарный поиск индекса заданного элемента одномерного "случайного"
' числового массива, строго упорядоченного по возрастанию (рекурсивный вариант).
Option Explicit
Dim i, s, key
Const n=8
Dim B (8)
'-------------------------------------------------------------------------------------
Function Bin_Search (B, low, high, x)
Dim mid
If low>high Then
Bin_Search=0
Else
mid=(low+high)\2
If x=B(mid) Then
Bin_Search=mid
Else
If x<B(mid) Then
Bin_Search=Bin_Search (B, low, mid-1, x)
Else
Bin_Search=Bin_Search (B, mid+1, high, x)
End If
End If
End If
End Function
'-------------------------------------------------------------------------------------
' Ввод одномерного массива, отсортированного строго по возрастанию
For i=0 to n
B(i)=CDbl(InputBox("Введите "&i&"-й элемент одномерного массива",_
"Ввод строго возрастающего вектора B:", i))
s=s&B(i)&" "
Next
s=s&vbCrLf
key=CDbl(InputBox("Введите искомый элемент: ","Окно ввода:", 5))
If Bin_Search (B, 1, n, key)=0 Then
MsgBox "Массив: "&s&vbCrLf&_
"Элемент "&key&" не найден в массиве!"
Else MsgBox "Массив: "&s&vbCrLf&_
"Элемент "&key&" найден в массиве!"&vbCrLf&_
"Его индекс в массиве: "&Bin_Search (B, 1, n, key)
End If
Пример 10
' Имя файла Mediana.vbs
' Поиск медианы в массиве.
' Реализация алгоритма Ч. Хоара.
' Медианой массива, содержащего N элементов, называется элемент, значение которого 'меньше (или равно) половины N элементов и больше (или равно) другой половины.
'Например, медианой массива 16 22 99 95 18 87 10 является 18. Задачу поиска медианы 'можно связать с сортировкой следующим образом: вначале произвести сортировку массива, 'а затем выбрать “средний элемент”. Но приведённая ниже программа позволяет найти 'медиану значительно быстрее.
Option Explicit
Dim i, s, k
Const n=8
Dim B (8)
'-------------------------------------------------------------------------------------
Sub Find (k)
Dim l, r, i, j, w, x
l=1 : r=n
While l<r
x=B(k) : i=l : j=r
Do
While B(i)<x
i=i+1
Wend
While x<B(j)
j=j-1
Wend
If i<=j Then
w=B(i) : B(i)=B(j) : B(j)=w : i=i+1 : j=j-1
End If
Loop Until i>j
If j<k Then
l=i
End If
If k<i Then
r=j
End If
Wend
End Sub
'-------------------------------------------------------------------------------------
' Заполнение одномерного массива случайными числами
For i=0 to n
Randomize
B(i)=Fix(Rnd(1)*20)
s=s&B(i)&" "
Next
s=s&vbCrLf
k=n\2
Find (k)
MsgBox "Массив: "&s&vbCrLf&_
"Медиана данного массива: "&B(k),_
vbInformation,_
"Результат: "
