Результаты работы программы.
Результаты работы иллюстрируются ниже на рисунках 7(сортировка массива из 10 элементов) и 8(исследование методов сортировки).
Р
исунок7.Метод
сортировки бинарными вставками.
Гистограмма
Рисунок8.Сравнительный графи
Выводы.
Среда разработки Visual Basic 6.0 позволяет эффективно и быстро решать различные вычислительные задачи.
Созданное программное обеспечение позволяет проводить исследование сортировки массивов методами простой вставки и бинарной вставки. При этом результаты эксперимента отображаются в текстовом виде и в графическом виде (сравнительные графики).
Программа позволяет выполнять визуализацию сортировки массивов при размерности N = 10. Массив для визуализации инициализируется из текстового файла. Результаты для одного из методов выводятся в таблицу и отображаются в виде гистограммы.
Исследование показало, что метод бинарной вставки по скорости превосходит метод простых вставок приблизительно в 2 раза. Графически это отображено на сравнительном графике.
Листинг программы
Модуль главной формы
Private Sub BinarIns_Click()
frmSchemeBinar.Show vbModal
End Sub
Private Sub MDIForm_Load()
Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
LoadNewDoc
End Sub
Private Sub LoadNewDoc()
Static lDocumentCount As Long
Dim frmD As frmDocument
lDocumentCount = lDocumentCount + 1
Set frmD = New frmDocument
frmD.Caption = "Document " & lDocumentCount
frmD.Show
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
If Me.WindowState <> vbMinimized Then
SaveSetting App.Title, "Settings", "MainLeft", Me.Left
SaveSetting App.Title, "Settings", "MainTop", Me.Top
SaveSetting App.Title, "Settings", "MainWidth", Me.Width
SaveSetting App.Title, "Settings", "MainHeight", Me.Height
End If
End Sub
Private Sub mnuinformationdescribe_Click()
frmInformation.Show vbModal
End Sub
Private Sub mnugrafikgraph_Click()
frmGraph.Show vbModal
End Sub
Private Sub mnugrafikillustration_Click()
frmIllustration.Show vbModal
End Sub
Private Sub mnusortsimple_Click()
frmSimple.Show vbModal
End Sub
Private Sub mnusortbinar_Click()
frmBinar.Show vbModal
End Sub
Private Sub mnuFileSaveAs_Click()
Dim sFile As String
If ActiveForm Is Nothing Then Exit Sub
With dlgCommonDialog
.DialogTitle = "Save As"
.CancelError = False
'ToDo: set the flags and attributes of the common dialog control
.Filter = "All Files (*.*)|*.*"
.ShowSave
If Len(.FileName) = 0 Then
Exit Sub
End If
sFile = .FileName
End With
ActiveForm.Caption = sFile
ActiveForm.rtfText.SaveFile sFile
End Sub
Private Sub SimpleIns_Click()
frmSchemeSimple.Show vbModal
End Sub
Private Sub Tree_Click()
frmTree.Show vbModal
End Sub
Модуль frmDocument
Private Sub Form_Load()
Dim s As String
s = "ФЕДЕРАЛЬНОЕ АГЕНСТВО ПО ОБРАЗОВАНИЮ" & vbCrLf
s = s & "ГОСУДАРСТВЕННОЕ ОБРАЗОВАТЕЛЬНОЕ УЧЕРЕЖДЕНИЕ ВЫСШЕГО ПРОФЕССИОНАЛЬНОГО ОБРАЗОВАНИЯ" & vbCrLf
s = s & "УФИМСКИЙ ГОСУДАРСТВЕННЫЙ АВИАЦИОННЫЙ ТЕХНИЧЕСКИЙ УНИВЕРСИТЕТ"
s = s & vbCrLf & vbCrLf & "курсовая работа на тему:" & vbCrLf
s = s & "ИССЛЕДОВАНИЕ МЕТОДОВ СОРТИРОВКИ МАССИВОВ" & vbCrLf & vbCrLf
s = s & "Автор программы студент группы СП-155" & vbCrLf
s = s & "ГАРИФУЛЛИН Р.Р." & vbCrLf & vbCrLf
s = s & "УФА 2007."
Label1.Caption = s: s = ""
End Sub
Модуль frmSimple
Option Explicit
Dim msfg As MSFlexGrid, sctm10 As Integer
Private Sub btOk_Click()
Unload Me
End Sub
Private Sub Form_Load()
Set msfg = Me.MSFlexGrid1
msfg.FixedRows = 1: Col_Rownomer: RowColsAvto
msfg.TextMatrix(0, 1) = "Исходный"
msfg.TextMatrix(0, 2) = "Сортированный"
End Sub
Private Sub Form_Close()
sctm10 = 0
End Sub
Private Sub Form_Activate()
Text1.SetFocus
End Sub
Public Sub Col_Rownomer()
Dim i As Integer
For i = 0 To (msfg.Rows - 1)
msfg.TextMatrix(i, 0) = i
Next i
i = 0
msfg.ColWidth(i) = 480
For i = 1 To (msfg.Cols - 1)
msfg.TextMatrix(0, i) = i
msfg.ColWidth(i) = 960
Next i
End Sub
Public Sub RowColsAvto()
Dim i As Long
For i = 0 To msfg.Rows - 1
msfg.RowHeight(i) = 240
Next i
For i = 1 To msfg.Cols - 1
msfg.ColWidth(i) = 1300
Next i
End Sub
Private Sub btAdd_Click()
Dim x As Long
On Error GoTo Handler
If IsNumeric(Text1.Text) Then
x = CLng(Text1.Text)
If x > 0 And x <= 100 Then
sctm10 = sctm10 + 1
m10(sctm10) = x
msfg.TextMatrix(sctm10, 1) = x
If sctm10 = UBound(m10) Then
btAdd.Enabled = False
btInsert.Enabled = True
End If
End If
End If
Handler:
If Err.Number <> 0 Then
Err.Clear
End If
Text1 = ""
Text1.SetFocus
End Sub
Private Sub btInsert_Click()
Dim i As Integer
InsertionSort m10, UBound(m10)
For i = LBound(m10) To UBound(m10)
msfg.TextMatrix(i, 2) = m10(i)
Next i
End Sub
Модуль frmBinar
Option Explicit
Dim msfg As MSFlexGrid, sctm10 As Integer
Private Sub btOk_Click()
Unload Me
End Sub
Private Sub Form_Load()
Set msfg = Me.MSFlexGrid1
msfg.FixedRows = 1: Col_Rownomer: RowColsAvto
msfg.TextMatrix(0, 1) = "Исходный"
msfg.TextMatrix(0, 2) = "Сортированный"
End Sub
Private Sub Form_Activate()
Text1.SetFocus
End Sub
Private Sub GistoGramma()
Dim i As Double, j As Long, k As Double
Dim t As Double '"шаг построения"
Dim ta As Double '"текущий аргумент"
Dim x0 As Double, y0 As Double, x1 As Double, y1 As Double
Dim xcnt As Double, ycnt As Double, vpole As Double, gpole As Double
Dim shag_x As Double, shag_y As Double, Tmp As Double
Dim dzsy As Double, dzsx As Double
Dim ymax As Double
On Error GoTo HandlerError
Picture1.Cls
Rem "устанавливаем масштаб по оси X"
Picture1.ScaleWidth = 24
gpole = 2
shag_x = 2
'Picture1.ScaleHeight = upperbound * 1.2: vpole = upperbound * 0.1
Picture1.ScaleHeight = 120: vpole = 10
xcnt = gpole: ycnt = Picture1.ScaleHeight - vpole
Rem "рисуем координатные линии"
Picture1.Line (0, ycnt)-(Picture1.ScaleWidth, ycnt)
Picture1.Line (xcnt, 0)-(xcnt, Picture1.ScaleHeight)
Picture1.CurrentX = Picture1.ScaleWidth * 0.9
Picture1.CurrentY = ycnt + Picture1.ScaleHeight * 0.04
Picture1.Print "Индекс"
Picture1.CurrentX = xcnt + dzsx
Picture1.CurrentY = 0.005 * Picture1.ScaleHeight
Picture1.Print "Значение элемента"
Rem "рисование элементов гистограммы"
i = xcnt
k = xcnt - 1
For j = LBound(m10) To UBound(m10)
i = i + 2
k = k + 2
Picture1.CurrentX = i - 1
Picture1.CurrentY = ycnt + Picture1.ScaleHeight * 0.005
Picture1.Print m10(j)
Picture1.ForeColor = QBColor(10)
Picture1.Line (k, ycnt)-(k + 1.5, ycnt - m10(j)), , BF
Picture1.ForeColor = QBColor(0)
Next j
HandlerError:
If Err <> 0 Then
Err.Clear
End If
End Sub
Private Sub Col_Rownomer()
Dim i As Integer
For i = 0 To (msfg.Rows - 1)
msfg.TextMatrix(i, 0) = i
Next i
i = 0
msfg.ColWidth(i) = 480
For i = 1 To (msfg.Cols - 1)
msfg.TextMatrix(0, i) = i
msfg.ColWidth(i) = 960
Next i
End Sub
Private Sub RowColsAvto()
Dim i As Long
For i = 0 To msfg.Rows - 1
msfg.RowHeight(i) = 240
Next i
For i = 1 To msfg.Cols - 1
msfg.ColWidth(i) = 1300
Next i
End Sub
Private Sub btAdd_Click()
Dim x As Long
On Error GoTo Handler
If IsNumeric(Text1.Text) Then
x = CLng(Text1.Text)
If x > 0 And x <= 100 Then
sctm10 = sctm10 + 1
m10(sctm10) = x
msfg.TextMatrix(sctm10, 1) = x
If sctm10 = UBound(m10) Then
btAdd.Enabled = False
btBinar.Enabled = True
End If
End If
End If
Handler:
If Err.Number <> 0 Then
Err.Clear
End If
Text1 = ""
Text1.SetFocus
End Sub
Private Sub btBinar_Click()
Dim i As Integer
BinaryInsertionSort m10, UBound(m10)
For i = LBound(m10) To UBound(m10)
msfg.TextMatrix(i, 2) = m10(i)
Next i
GistoGramma
Handler:
If Err.Number <> 0 Then
Err.Clear
End If
End Sub
Модуль frmInformation
Private Sub btOk_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim f As String, s As String
f = App.Path & "\" & "metod.txt"
Open f For Input As #1
Text1 = ""
Do While Not EOF(1)
Line Input #1, s
Text1 = Text1 & s & vbCrLf
Loop
Close #1
End Sub
Модуль frmGraph
Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Const ResultFile As String = "Result.txt"
Private Const NameMtd1 As String = "Метод простых вставок"
Private Const NameMtd2 As String = "Метод бинарных вставок"
Private Const StartVal = 500
Private Const EndVal = 5000
Private Const shag = 50
Private Const MaxEndVal = 5000
Dim J_Max As Integer
Dim indcancel As Boolean '"нажатие отмены"
Dim m10(1 To 10) As Long
Dim m5000(1 To 5000) As Long
Private Type grfpnt
x As Single
y As Single
End Type
Dim mpnt1(0 To 90) As grfpnt '"массив точек 1 графика"
Dim mpnt2(0 To 90) As grfpnt '"массив точек 2 графика"
Dim timeMax As Double '"макс. время сортировки"
Dim sctm10 As Integer
Dim vs As Single '"текущее время сортировки"
Private Sub btOk_Click()
Unload Me
End Sub
Private Sub CmdGrafik_Click()
Dim i As Integer, tm As Single, j As Integer
Dim k As Integer
On Error GoTo Handler
Rem "первый метод"
Rem "обнуление максимума и массива координат точек"
timeMax = 0
For i = LBound(mpnt1) To UBound(mpnt1)
mpnt1(i).x = StartVal + shag * i: mpnt1(i).y = 0
Next i
Rem "массив точек для первого метода - 1"
j = LBound(mpnt1) - 1
Progress = ""
For i = StartVal To EndVal Step shag
Rem "инициализация большого массива"
For k = LBound(m5000) To UBound(m5000)
m5000(k) = Int((1000 * Rnd) + 1)
Next k
vs = 0
tm = timeGetTime
InsertionSort m5000, i
vs = (timeGetTime - tm) / 1000
j = j + 1
mpnt1(j).y = Abs(vs)
Progress = i
If timeMax < vs Then timeMax = vs
DoEvents
If indcancel Then
indcancel = False
Progress = ""
Exit Sub
End If
Next i
J_Max = j
SaveResExper 1, J_Max, ResultFile, True '"сохранение в файле"
Rem "второй метод - 2"
Rem "обнуление максимумов и массивов координат точек"
For i = LBound(mpnt2) To UBound(mpnt2)
mpnt2(i).x = StartVal + shag * i: mpnt2(i).y = 0
Next i
j = LBound(mpnt2) - 1
Progress = ""
For i = StartVal To EndVal Step shag
Rem "инициализация большого массива"
For k = LBound(m5000) To UBound(m5000)
m5000(k) = Int((1000 * Rnd) + 1)
Next k
vs = 0
tm = timeGetTime
BinaryInsertionSort m5000, i
vs = (timeGetTime - tm) / 1000
j = j + 1
mpnt2(j).y = Abs(vs)
Progress = i
If timeMax < vs Then timeMax = vs
DoEvents
If indcancel Then
indcancel = False
Progress = ""
Exit Sub
End If
Next i
J_Max = j
SaveResExper 2, J_Max, ResultFile, False '"сохранение в файле"
Call ShowGrafik(timeMax, 10, 12)
Handler:
If Err.Number <> 0 Then
Err.Clear
End If
End Sub
Private Sub ShowGrafik(maxt As Double, cvet1 As Integer, cvet2 As Integer)
Dim i As Double, j As Long
Dim t As Double '"шаг построения"
Dim ta As Double '"текущий аргумент"
Dim x0 As Double, y0 As Double, x1 As Double, y1 As Double
Dim xcnt As Double, ycnt As Double, vpole As Double, gpole As Double
Dim shag_x As Double, shag_y As Double, Tmp As Double
Dim dzsy As Double, dzsx As Double
Dim ymax As Double
On Error GoTo HandlerError
Picture1.Cls
ymax = maxt
Rem "устанавливаем масштаб по оси X"
Picture1.ScaleWidth = MaxEndVal * 1.2
gpole = MaxEndVal * 0.1
shag_x = 500
If ymax < 0.1 Then
Picture1.ScaleHeight = 0.12: vpole = 0.01
shag_y = 0.02
ElseIf ymax >= 0.1 And ymax < 0.25 Then
Picture1.ScaleHeight = 0.3: vpole = 0.025
shag_y = 0.05
ElseIf ymax >= 0.25 And ymax < 0.5 Then
Picture1.ScaleHeight = 0.6: vpole = 0.05
shag_y = 0.1
ElseIf ymax >= 0.5 And ymax < 1 Then
Picture1.ScaleHeight = 1.2: vpole = 0.1
shag_y = 0.2
ElseIf ymax > 1 And ymax <= 5 Then
Picture1.ScaleHeight = 6: vpole = 0.5
shag_y = 1
ElseIf ymax > 5 And ymax <= 10 Then
Picture1.ScaleHeight = 12: vpole = 1
shag_y = 2
ElseIf ymax > 10 And ymax <= 30 Then
Picture1.ScaleHeight = 36: vpole = 3
shag_y = 5
ElseIf ymax > 30 Then
Picture1.ScaleHeight = 120: vpole = 10
shag_y = 10
End If
dzsy = Picture1.ScaleHeight * 0.01
dzsx = Picture1.ScaleWidth * 0.01
xcnt = gpole: ycnt = Picture1.ScaleHeight - vpole
Rem "рисуем координатные линии"
Picture1.Line (0, ycnt)-(Picture1.ScaleWidth, ycnt)
Picture1.Line (xcnt, 0)-(xcnt, Picture1.ScaleHeight)
Rem "рисуем засечки"
For i = shag_x + gpole To Picture1.ScaleWidth - gpole Step shag_x
Picture1.Line (i, ycnt)-(i, ycnt - dzsy)
Picture1.CurrentX = i - dzsx: Picture1.CurrentY = ycnt + dzsy
Picture1.Print (i - gpole) / 1000
Next i
Picture1.CurrentX = Picture1.ScaleWidth * 0.96
Picture1.CurrentY = ycnt - Picture1.ScaleHeight * 0.03
Picture1.Print "N"
Picture1.CurrentX = Picture1.ScaleWidth * 0.96
Picture1.CurrentY = ycnt + Picture1.ScaleHeight * 0.01
Picture1.Print "E3"
j = 0
For i = Picture1.ScaleHeight - vpole - shag_y To vpole Step -shag_y
Picture1.Line (xcnt, i)-(xcnt + dzsx, i)
j = j + 1
Picture1.CurrentX = xcnt + dzsx
Picture1.CurrentY = i - 0.01 * Picture1.ScaleHeight
Picture1.Print j * shag_y
Next i
Picture1.CurrentX = xcnt + dzsx
Picture1.CurrentY = 0.01 * Picture1.ScaleHeight
Picture1.Print "t, сек"
Rem "рисование графика 1 метода"
Picture1.ForeColor = QBColor(cvet1)
j = LBound(mpnt1)
t = shag
x0 = xcnt + mpnt1(j).x
y0 = ycnt - mpnt1(j).y
Do While j < J_Max
j = j + 1
x1 = xcnt + mpnt1(j).x
y1 = ycnt - mpnt1(j).y
If j > J_Max Then Exit Do '"чтобы лишнего не строить"
Picture1.Line (x0, y0)-(x1, y1)
x0 = x1: y0 = y1
Loop
Rem "рисование графика 2 метода"
Picture1.ForeColor = QBColor(cvet2)
j = 0
t = shag
x0 = xcnt + mpnt2(j).x
y0 = ycnt - mpnt2(j).y
Do While j < J_Max
j = j + 1
x1 = xcnt + mpnt2(j).x
y1 = ycnt - mpnt2(j).y
If j > J_Max Then Exit Do '"чтобы лишнего не строить"
Picture1.Line (x0, y0)-(x1, y1)
x0 = x1: y0 = y1
Loop
Picture1.ForeColor = QBColor(0)
Picture1.CurrentX = Picture1.ScaleWidth * 0.3
Picture1.CurrentY = 0.01 * Picture1.ScaleHeight
Picture1.Print "Зеленый цвет - метод простых вставок"
Picture1.CurrentX = Picture1.ScaleWidth * 0.3
Picture1.Print "Красный цвет - метод бинарных вставок"
HandlerError:
If Err <> 0 Then
Err.Clear
End If
End Sub
Private Sub SaveResExper(nmas As Integer, nn As Integer, _
fname As String, crtnew As Boolean)
Dim s As String, s2 As String, i As Long
On Error GoTo HandlerError
Select Case crtnew
Case True
Open App.Path & "\" & fname For Output As #1
Case False
Open App.Path & "\" & fname For Append As #1
End Select
Print #1, ""
Select Case nmas
Case 1
s = NameMtd1: Print #1, s
Case 2
s = NameMtd2: Print #1, s
End Select
s = "Число N" & vbTab & "Время, сек"
Print #1, s
Select Case nmas
Case 1
For i = LBound(mpnt1) To nn
s = mpnt1(i).x & vbTab & mpnt1(i).y
Print #1, s
Next i
Case 2
For i = LBound(mpnt1) To nn
s = mpnt2(i).x & vbTab & mpnt2(i).y
Print #1, s
Next i
End Select
Close #1
HandlerError:
If Err <> 0 Then
Err.Clear
End If
End Sub
Модуль1
Option Base 1
Public fMainForm As frmMain
Public m10(1 To 10) As Long, J_Max As Integer
Sub Main()
Set fMainForm = New frmMain
fMainForm.Show
End Sub
Public Sub BinaryInsertionSort(arr() As Long, 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 R As Long
On Error GoTo HandlerError
i = 2
Do
B = 1
E = i - 1
C = (B + E) \ 2
Do While B <> C
If arr(C) > arr(i) Then
E = C
Else
B = C
End If
C = (B + E) \ 2
Loop
If arr(B) < arr(i) Then
If arr(i) > arr(E) Then
B = E + 1
Else
B = E
End If
End If
k = i
R = arr(i)
Do While k > B
arr(k) = arr(k - 1)
k = k - 1
Loop
arr(B) = R
i = i + 1
Loop Until Not i <= n
HandlerError:
If Err <> 0 Then
Err.Clear
End If
End Sub
Public Sub InsertionSort(mas() As Long, ByVal n As Long)
Dim i As Long
Dim j As Long
Dim k As Long
Dim R As Long
On Error GoTo HandlerError
i = 2
Do
j = 1
Do
If mas(i) < mas(j) Then
k = i
R = mas(i)
Do
mas(k) = mas(k - 1)
k = k - 1
Loop Until Not k > j
mas(j) = R
j = i
Else
j = j + 1
End If
Loop Until Not j < i
i = i + 1
Loop Until Not i <= n
HandlerError:
If Err <> 0 Then
Err.Clear
End If
End Sub