Visual Basic FAQ

Выполнить сортировку чисел в массиве по возрастанию.

Option Explicit
Dim vArray, vMid As Long, vBuf As Long 'для QuickSort массив и две переменные следует объявить в General/Declarations
Dim cnt_Compares As Long, cnt_Moves As Long

Sub Inc(L As Long, Optional D As Long = 1)
  L = L + D
End Sub

Sub sort_Пузырьки(vArray)
Dim I As Long, J As Long, D As Long
Inc cnt_Moves, 3 '2 раза присвоить и 1 вычесть
For I = LBound(vArray) To UBound(vArray) - 1
  Inc cnt_Moves, 4 '2 раза присвоить, 1 сложить и 1 вычесть
  For J = UBound(vArray) To I + 1 Step -1
    Inc cnt_Compares
    If vArray(I) > vArray(J) Then
      Inc cnt_Moves, 3
      D = vArray(I)
      vArray(I) = vArray(J)
      vArray(J) = D
    End If
    Inc cnt_Compares 'J > I + 1?
    Inc cnt_Moves 'J + Step
  Next J
  Inc cnt_Compares 'I < LBound(vArray)?
  Inc cnt_Moves 'I + Step
Next I
End Sub

Sub ShellSort(vArray As Variant) 'счетчики сделай как в Sub sort_Пузырьки
Dim TempVal As Variant
Dim I As Long, GapSize As Long, CurPos As Long
Dim FirstRow As Long, LastRow As Long, NumRows As Long
  FirstRow = LBound(vArray)
  LastRow = UBound(vArray)
  NumRows = LastRow - FirstRow + 1
  Do
    GapSize = GapSize * 3 + 1
  Loop Until GapSize > NumRows
  Do
    GapSize = GapSize \ 3
    For I = (GapSize + FirstRow) To LastRow
      CurPos = I
      TempVal = vArray(I)
      Do While vArray(CurPos - GapSize) > TempVal
        vArray(CurPos) = vArray(CurPos - GapSize)
        CurPos = CurPos - GapSize
        If (CurPos - GapSize) < FirstRow Then Exit Do
      Loop
      vArray(CurPos) = TempVal
    Next
  Loop Until GapSize = 1
End Sub

Sub QuickSort(ByVal L As Long, ByVal U As Long) 'счетчики сделай как в Sub sort_Пузырьки
Dim I As Long, J As Long
I = L
J = U
vMid = vArray((L + U) \ 2)
Do
  While vArray(I) < vMid
    I = I + 1
  Wend
  While vMid < vArray(J)
    J = J - 1
  Wend
  If I <= J Then
    vBuf = vArray(I)
    vArray(I) = vArray(J)
    vArray(J) = vBuf
    I = I + 1
    J = J - 1
  End If
Loop Until I > J
If L < J Then QuickSort L, J
If I < U Then QuickSort I, U
End Sub

Sub GetArray()
Dim S As String, V, I As Long, J As Long, A() As Long
Dim T As Single, Date_Start As Date, Date_Finish As Date
S = InputBox("Введите числа через пробел для сортировки:", "Сортировка")
V = Split(S)
For I = 0 To UBound(V)
  If V(I) <> "" Then 'на всякий случай (вдруг лишний пробел попадется)
    J = J + 1
    ReDim Preserve A(1 To J)
    A(J) = Val(V(I))
  End If
Next I
S = "пузырьками"
vArray = A
Date_Start = Date
T = Timer
sort_Пузырьки vArray
GoSub msg

S = "Шелла"
vArray = A
ShellSort vArray
GoSub msg

S = "Хоара"
vArray = A
QuickSort LBound(vArray), UBound(vArray)
GoSub msg

Exit Sub

msg:
Date_Finish = Date
MsgBox "Время сортировки " & (Timer - T + 24! * 60 * 60 * (Date_Finish - Date_Start)) & vbLf & _
"Сравнений " & cnt_Compares & vbLf & _
"Действий " & cnt_Moves, , "Сортировка " + S
cnt_Moves = 0
cnt_Compares = 0
T = Timer
Date_Start = Date
Return
End Sub

Запись опубликована on 01.12.2009 at 9:06 и размещена в рубрике: Задачи. Вы можете читать комментарии, используя RSS-ленту. Вы можете оставить комментарий, или отправить трекбек с Вашего сайта.