Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
52
Добавлен:
02.05.2014
Размер:
357.89 Кб
Скачать

Результаты работы программы.

Результаты работы иллюстрируются ниже на рисунках 7(сортировка массива из 10 элементов) и 8(исследование методов сортировки).

Рисунок7.Метод сортировки бинарными вставками. Гистограмма

Рисунок8.Сравнительный графи

Выводы.

  1. Среда разработки Visual Basic 6.0 позволяет эффективно и быстро решать различные вычислительные задачи.

  2. Созданное программное обеспечение позволяет проводить исследование сортировки массивов методами простой вставки и бинарной вставки. При этом результаты эксперимента отображаются в текстовом виде и в графическом виде (сравнительные графики).

  3. Программа позволяет выполнять визуализацию сортировки массивов при размерности N = 10. Массив для визуализации инициализируется из текстового файла. Результаты для одного из методов выводятся в таблицу и отображаются в виде гистограммы.

  4. Исследование показало, что метод бинарной вставки по скорости превосходит метод простых вставок приблизительно в 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

Соседние файлы в папке Курсовая работа по Visual Basic3