Sort Routine?

[But_Why]

I want a sort routine that runs quick and is efficient. I don't mind if its a bubble sort, or quick sort. Just something that is quick.
What i have is a type structure array:

Type stuff
    aString as String * 12
    aMaxVal as long
    aMinVal as long
end type

public stuffArray() as stuff

Private Sub Form_Load()
    variableNumber = Int((rnd * 20)+1)
    redim stuffArray(1 to variableNumber)
end sub

Ok, now thats a little clearer. I have that array, that is variably sized. I now want a sort routine, to sort on the percentage made by:

    percentage = int((aMinVal / aMaxVal) * 100)

and then place the sorted array into another array to be passed back from the sub, ie

Private Sub sortArray(incomingArray() as stuff, sortedArray() as stuff)

That way i can pass the array in, and get the ubound and lbound of it and send one of the same size back.

Any ideas? It seems fairly simple and i have a sort routine at the moment, but it seems to bulky. I know it can be done better.
Cheers
BW

[Edited by But_Why on 09-21-2000 at 04:28 PM]

[HarryW]

Okay, dunno the quickest way to sort but one I usually use is a selection sort - go through the array and pick out the next highest/lowest a number of times equal to the number of elements.

Don't quite remember but I think arrays are always passed ByRef.

Private Sub sortArray(incomingArray() as stuff, sortedArray() as stuff)
Redim sortedArray(Ubound(incomingArray)) 'dunno if you need this
Dim max As Integer
Dim maxPercentage As Integer you want
For x = 1 To Ubound(incomingArray)
  max = x
  maxPercentage = 0
  For y = x To Ubound(incomingArray)
    With incomingArray(y)
      If Int((.aMinVal / .aMaxVal) * 100) > maxPercentage Then
        maxPercentage = Int((.aMinVal / .aMaxVal) * 100)
        max = x)
      End If
    End With
  Next y
  sortedArray(x) = incomingArray(max)
Next x
End Sub

I haven't tested it but so far as I can tell that code is a selection sort, customised for what you need.

[Edited by HarryW on 09-21-2000 at 05:09 PM]

[But_Why]

dim upBound as long
upBound = Ubound(incomingArray)

and replace Ubound(incomingArray) with upBound whereever you have used it, i have heard its quicker, cos it doesn't have to recalculate it everytime.
But i could be wrong, and thanks for the quick reply.
Will try it out.
Cheers
BW

Originally posted by HarryW
Okay, dunno the quickest way to sort but one I usually use is a selection sort - go through the array and pick out the next highest/lowest a number of times equal to the number of elements.

Don't quite remember but I think arrays are always passed ByRef.

Private Sub sortArray(incomingArray() as stuff, sortedArray() as stuff)
Redim sortedArray(Ubound(incomingArray)) 'dunno if you need this
Dim max As Integer
Dim maxPercentage As Integer you want
For x = 1 To Ubound(incomingArray)
  max = x
  maxPercentage = 0
  For y = x To Ubound(incomingArray)
    With incomingArray(y)
      If Int((.aMinVal / .aMaxVal) * 100) > maxPercentage Then
        maxPercentage = Int((.aMinVal / .aMaxVal) * 100)
        max = x)
      End If
    End With
  Next y
  sortedArray(x) = incomingArray(max)
Next x
End Sub

I haven't tested it but so far as I can tell that code is a selection sort, customised for what you need.

[Edited by HarryW on 09-21-2000 at 05:09 PM]

[But_Why]

i have heard that a selection sort is good, as its quick for small arrays, which i have, but the code you gave me is a no go.
It simply prints out the exact same order as before.
And if i change max = x in the if statement to max = y i only get all the same value (as one of the lower items in the array has the largest percentage)
Any ideas how i need to change this to fix it?
BW
(knowing my luck its something bloody obvious, but i can't for the life of me see it yet !!!)

[Iain17]

Here is a quicksort that i picked up off the web and have modified because it was for VBA.

Simply change the type, and which property of the type to sort on.

'to call it
Quicksort apiArray, LBound(apiArray), UBound(apiArray)

Sub Quicksort(values() As APIType, _
              ByVal min As Long, _
              ByVal max As Long)

  Dim med_value As APIType
  Dim hi As Long
  Dim lo As Long
  Dim i As Long

  ' If the list has only 1 item, it's sorted.
  If min >= max Then Exit Sub

  ' Pick a dividing item randomly.
  Randomize
  i = min + Int((max - min) \ 2)
  
  med_value = values(i)

  ' Swap the dividing item to the front of the list.
  values(i) = values(min)

  ' Separate the list into sublists.
  lo = min
  hi = max
  Do
    ' Look down from hi for a value < med_value.
    Do While StrComp(values(hi).Name, med_value.Name, vbTextCompare) >= 0
      hi = hi - 1
      If hi <= lo Then Exit Do
    Loop

    If hi <= lo Then
      ' The list is separated.
      values(lo) = med_value
      Exit Do
    End If

    ' Swap the lo and hi values.
    values(lo) = values(hi)

    ' Look up from lo for a value >= med_value.
    lo = lo + 1
    Do While StrComp(values(lo).Name, med_value.Name, vbTextCompare) <= 0
    lo = lo + 1
      If lo >= hi Then Exit Do
    Loop

    If lo >= hi Then
      ' The list is separated.
      lo = hi
      values(hi) = med_value
      Exit Do
    End If

    ' Swap the lo and hi values.
    values(hi) = values(lo)
  Loop ' Loop until the list is separated.

  ' Recursively sort the sublists.
  Quicksort values, min, lo - 1
  Quicksort values, lo + 1, max

End Sub

A heap sort would be even quicker, but i do not have the code for it, and i am not about to write it when i already have a quicksort.

[Edited by Iain17 on 09-21-2000 at 06:22 PM]

[But_Why]

No-one can see what is wrong with this one???
Megatron, you seem to be good at finding things. Any Ideas?
Anyone? I have seen that quicksort, and i would prefer the selection sort. Anyone see why it doesn't work. I can see why? but not how to fix it.
BW :COOL:

[HarryW]

I'll take a look at it, sorry it didn't work first time

Oh I just realised, it's meant to sort an array, not copy to a new array. I'll modify it.

[HarryW]

Private Sub sortArray(incomingArray() As stuff, sortedArray() As stuff)
For x = LBound(sortedArray) To UBound(sortedArray)
    sortedArray(x) = incomingArray(x)
Next x
Dim max As Integer
Dim maxPercentage As Integer
Dim temp As stuff
For x = 1 To UBound(sortedArray)
  max = x
  maxPercentage = 0
  For y = x To UBound(sortedArray)
    With sortedArray(y)
      'If Int((.aMinVal / .aMaxVal) * 100) < maxPercentage Then 'for ascending order use this line
      If Int((.aMinVal / .aMaxVal) * 100) > maxPercentage Then 'for descending order use this line
        maxPercentage = Int((.aMinVal / .aMaxVal) * 100)
        max = y
      End If
    End With
  Next y
  'swap
  temp = sortedArray(max)
  sortedArray(max) = sortedArray(x)
  sortedArray(x) = temp
Next x
End Sub

There that should do it Choose a line for the if statement depending on whether you want ascending or descending order.

[HeSaidJoe]

'this is an example of bubble sort
'it will pass you back your array sorted.

Option Explicit

Sub SortNumbers(iArray As Variant)
     
     Dim lLoop1 As Long
     Dim lLoop2 As Long
     Dim lTemp As Long
     
     For lLoop1 = UBound(iArray) To LBound(iArray) Step -1
       For lLoop2 = LBound(iArray) + 1 To lLoop1

         If iArray(lLoop2 - 1) > iArray(lLoop2) Then
           lTemp = iArray(lLoop2 - 1)
           iArray(lLoop2 - 1) = iArray(lLoop2)
           iArray(lLoop2) = lTemp
         End If
       Next lLoop2
     Next lLoop1
   End Sub

Private Sub Command1_Click()
   ' make your array
   ' whatever else
   Call SortNumbers(yourarray)
   'do whatever..insert the array into next whatevers
   
End Sub

[But_Why]

Its all go! Excellent.

Thanks for that.
BW

[HarryW]

Happy to help

Hello guys,

This code works well, except for 1 minor thing,
maxPercentage should be initialized to sortedArray(x) instead of 0.
0 works fine for descending order, but will not work for ascending. Also first For.. Next loop is not needed as sort can be done on incoming array, don't really need output array.



Private Sub sortArray(incomingArray() As stuff, sortedArray() As stuff)
For x = LBound(sortedArray) To UBound(sortedArray)
sortedArray(x) = incomingArray(x)
Next x
Dim max As Integer
Dim maxPercentage As Integer
Dim temp As stuff
For x = 1 To UBound(sortedArray)
max = x
maxPercentage = 0
For y = x To UBound(sortedArray)
With sortedArray(y)
'If Int((.aMinVal / .aMaxVal) * 100) < maxPercentage Then 'for ascending order use this line
If Int((.aMinVal / .aMaxVal) * 100) > maxPercentage Then 'for descending order use this line
maxPercentage = Int((.aMinVal / .aMaxVal) * 100)
max = y
End If
End With
Next y
'swap
temp = sortedArray(max)
sortedArray(max) = sortedArray(x)
sortedArray(x) = temp
Next x
End Sub

[HarryW]

The element sortedArray(x) isn't an integer, it's of type stuff. Perhaps you mean the percentage given in that array element. Other than that it's fair comment, but the function still needs editing to change it to work in ascending order.

Secondly, on the subject of the first For...Next loop: it is necessary given the Sub prototype specified, which has an input array and an output array as parameters. I said this in the post before my second block of code. A selection sort works by sorting an existing array, not creating a new, sorted array.

"element sortedArray(x) isn't an integer, it's of type stuff. Perhaps you mean the percentage given in that array element."
Yes, that's what I meant. Off course you still need to use either < or > for ascending or descending order.

"For...Next loop"
You need just one array, you don't need to pass 2 of them, unless you need one unsorted and one sorted.
Anyway code works fine, I'm using it, thanks.

[kedaman]

Ok, this is supposed to be fastest (or is it? I haven't seen any one like Harrys before

Sub Sort_shell(a() As String)
Dim n&, i&, j&, k&, h
 
    n = UBound(a)
    k = n \ 2
    While k > 0
        For i = 0 To n - k
            j = i
            While (j >= 0) And (a(j) > a(j + k))
            h = a(j)
            a(j) = a(j + k)
            a(j + k) = h
            If j > k Then
                j = j - k
            Else
                j = 0
            End If
            Wend
        Next i
        k = k \ 2
    Wend
End Sub

[HarryW]

Aostrowski: I am well aware that only one array is needed for a selection sort but if you read the function prototype you will see that it specifies an input and an output array. Thus that is what I provided.

Kedaman: is that a binary sort, or a bisection sort or whatever it's called? Is it faster than selection sort? A selection sort always requires n²/4 passes through the loop I think, where n is the number of elements. Any idea how much quicker yours is?

[Iain17]

I give up, take a look at the quicksort if you want speed. Alternativley, go for a heap sort as i said.

[kedaman]

well shellsort isn't the fastest, i just heard there was something like radix sort or something, way too advanced to be beaten.
But shell sort is amazing fast anyway: n
in other words proportional to the amount of items

[Frans C]

I did some comparing between the sorting routines i know (I added Kedaman's Sort_Shell method, I didn't know that one yet).
I sorted an array of 10000 strings which were all 50 characters long.
These are the results:
Bubble sort : 83.77213 secs
Selection sort : 50.87294 secs
Sort Shell : 0.9384375 secs
Quick sort : 0.2765 secs

So I would go for quick sort.

P.S. I used my PII 400 MHz and the compiled vb app.

[kurtsimons]

ok Kedaman..

I need to sort election results

candidate(0) = "Bush"
Votes(0) = "1000"
Candidate(1) = "Gore"
Votes(1)= "1200"


now I know how to sort the votes but how can I get Candidates to follow.

What about a multidementional array
Candidate(0,0) = "Bush"
Votes(0,1) = "1000"
Candidate(1,0) = "Gore"
Votes(1,1) = "1200"

what do I do or How Should I store my data differently

[agent]

With the quicksort function above, I got an average time of 4.5 seconds with the following specs:

266mhz cpu
vba 6 (word 2000)
10,000 items (every item out of order)
no interface updates at all during sorting

Please note that I could not test this in stand alone vb as I lost it in my housefire. If anybody knows of a good download site or a place I can get vb cheap, it would be much appreciated.

hi kurtsimons,
You can do array of types and sort on whatever you like.

[kedaman]

Yeah, Quicksorts quicker than ever!
Now kurtsimons, it would be faster to sort an UDT array but if you nessesary need two arrays, pass the array you want to sort by and then swap both arrays with the same indexes

[kurtsimons]

Oh Ya, simple questions get simple answers!

[Iain17]

Ok, sorry, but I thought I would stick my nose in again.

While the quicksort is indeed very quick, you need to use a bit of caution if you want to implement it. While I have not had a problem with it recently, I did have a problem with it on an older machine at work which did not have much memory.

Because the quicksort is recursive, you can of course run out of stack space. While you will probably need an extremely big list for this to happen on a modern computer, keep it in mind. If you have any doubts, use Kedaman’s shells sort.

[jp_schwartz]

Hey Kedaman, I think your code has a tiny bug: when I pass a two-record array, it doesn´t sort it. I noticed ´cause I´m using it on a new sort I´m doing. It is recursive and it allows you to make a multi-field sort. Each field could be ordered ascendent or descendent. The best part of it: you could change the sort part to use another method just changing one line. If someone is interested, let me know and I´ll post it here.

[RCharlton]

is also a useful way of speeding it up - you swap the pointers and not the values:


Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" _
(Dest As Any, Src As Any, ByVal cb As Long)

Public Sub StringSwap(strOne As String, strTwo As String)

Dim lngTemp As Long

'Store a copy of the pointer to first string
lngTemp = StrPtr(strOne)

'Replace pointer to strOne with pointer to strTwo
CopyMem ByVal VarPtr(strOne), ByVal VarPtr(strTwo), 4

'Replace pointer to strTwo with stored pointer
CopyMem ByVal VarPtr(strTwo), lngTemp, 4

End Sub

-- many many times faster