Sorting an Array Using Combsort
page 2 of 2
by Niels Martin Hansen
Feedback
Average Rating: This article has not yet been rated.
Views (Total / Last 10 Days): 20499/ 71
Article Contents:

Code
Option Explicit
Dim M, t1, t2 
Dim A()
Dim B()

Sub initB()
  Dim i
  Randomize
  for i=0 to M
    B(i)= Rnd
  next
End Sub

Sub A_equal_B()
  Dim i
  for i=0 to M
    A(i) = B(i)
  next  
End Sub

Sub CombSort()
'This procedure will sort the array A
'using the CombSort-methode
  Dim i,j,gap,x,OK
  gap = M
  OK = True
  While OK
    'You can try other values, but 1.33 seems to be the best
    gap= Int(gap/1.33)
    If gap < 1 Then gap = 1
    OK = (gap <> 1)
    For i = 0 To M - gap
      j = i + gap
      If A(i) > A(j) Then
        x = A(i)
        A(i) = A(j)
        A(j) = x
        OK = True
      End If
    Next
  Wend
End Sub

Sub Bobblesort()
'This procedure will sort the array A
'using the Bobblesort-methode
  Dim i,j,x
  For i = 0 To M-1
    For j = 0 To M-1 - i
      If A(j) > A(j + 1) Then
        x = A(j)
        A(j) = A(j + 1)
        A(j + 1) = x
      End If
    Next
  Next
End Sub

Private Sub showA(txt)
  Dim s
  s= txt & VBCrLf
  s= s & "Time: " & t2-t1 & VBCrLf
  'Show the sorted array for small values of M
  if M<100 then s= s & join(A," * ")
  MsgBox s
End Sub


M=Clng(InputBox("Number of elements to sort: "))
ReDim A(M)
ReDim B(M)
initB()

'Combsort: 
'M=1500: sorttime about 0.4 sec
A_equal_B()
t1=Timer
Combsort()
t2=Timer
showA("CombSort:")

'Bobblesort 
'M=1500: sorttime about 12 sec
'so be careful not to use Bobblesort for large values of M
if M<=1500 then  
  A_equal_B
  t1=Timer
  Bobblesort
  t2=Timer
  showA("BobbleSort")
end if

View Entire Article

User Comments

No comments posted yet.

Product Spotlight
Product Spotlight 





Community Advice: ASP | SQL | XML | Regular Expressions | Windows


©Copyright 1998-2018 ASPAlliance.com  |  Page Processed at 2018-10-19 4:13:01 PM  AspAlliance Recent Articles RSS Feed
About ASPAlliance | Newsgroups | Advertise | Authors | Email Lists | Feedback | Link To Us | Privacy | Search