Asp Forum - Sort Type - microsoft.public.vb.general.discussion

BeeJ

9/9/2011 2:54:00 AM

I have a sort routine that I wrote to sort types however it is not as
fast as I would like. My routine does it the hard way and moves each
part around. It works but I think it could be faster if it used
pointers instead. I have seen and tried to modify sort routines that
swap pointers but it always crashes.

This is a typical type array that I need to sort.

Public Type DataType
sKey as String
sItem as String
lIndex as Long
End Type
Public tData() as DataType

I would like to have a Sort routine like this:

Public Function Sort(tArr() as DataType, lElement as Long) as Boolean

' this would sort on the lElement of the type.
' so it lElement = 0 then the sort would work on sKey, etc

End Function 'Sort

Any pointers (lol) would be helpful.
I tried searching for VB6 Sort Type but got nothing using Types.

52 Answers

Mike Scirocco

9/9/2011 5:18:00 AM

On 9/8/2011 7:53 PM, BeeJ wrote:
> I have a sort routine that I wrote to sort types however it is not as
> fast as I would like. My routine does it the hard way and moves each
> part around. It works but I think it could be faster if it used pointers
> instead. I have seen and tried to modify sort routines that swap
> pointers but it always crashes.
> This is a typical type array that I need to sort.
> Public Type DataType
> sKey as String
> sItem as String
> lIndex as Long
> End Type
> Public tData() as DataType
> I would like to have a Sort routine like this:
> Public Function Sort(tArr() as DataType, lElement as Long) as Boolean
> ' this would sort on the lElement of the type.
> ' so it lElement = 0 then the sort would work on sKey, etc
> End Function 'Sort
> Any pointers (lol) would be helpful.
> I tried searching for VB6 Sort Type but got nothing using Types.

A lot of work has been done on VB sorting routines, if you do some
research on what's already out there you might consider comparing
different techniques against your own, these sites may be interesting:

http://www.vbforums.com/showthread.ph...

http://www.devx.com/vb2themax/Art...

https://sites.google.com/site/computersciencesourcecode/so...

http://www.allquests.com/question/1098559/VB6-Sorting-algorithms-sort-array-sorting-a...

If you compare your search times with some of the sort code in the above
cases you may find that an existing routines will work for you and be
faster, unless you've got a new impressively fast approach.

Mike

David Kaye

9/9/2011 9:29:00 AM

"BeeJ" <nospam@spamnot.com> wrote

> I have a sort routine that I wrote to sort types however it is not as fast
> as I would like.

Doubtless you'll be directed to various sort routines. Keep in mind the
kind of data you'll be using because there are distinct advantages to
particular kinds of sorts depending on the data you plan to sort.

Some routines work better on large datasets than on small ones, or data with
small gaps between the data versus large gaps, or on data where there is
more randomness or less randomness, and also how big the count is between
the smallest data and the largest. In sort routines it is not one size fits
all; to get speed you must optimize for the kind of data you're sorting.

Mayayana

9/9/2011 12:24:00 PM

I'm not an expert on sorting, but awhile back
I needed sorting in VBScript. I tested several
methods and concluded that quicksort was by
far the most efficient. You can see the samples
and results here:

http://www.jsware.net/jsware/scripts.ph...

You'll need to adapt any sorting routine if you're
going to have an unknown data type sorted, as
you've described.

It'd be interesting to hear the results if you test
pointers, but a decent sort routine is remarkably
fast, so it shouldn't matter unless you're dealing
with vast data.

I just wrote a VBScript the other day to sort my
server logs. The server doesn't always write GETs
in chronological order. Each line includes a string like
this: - [05/Sep/2011:08:53:03
So my job was to read in the file, split it into an array
of lines, parse each line to produce a numeric value
representing the time, create an array of numbers,
then sort the server log lines by sorting my numeric
array and write it all back to disk. I didn't time it, but
I don't really need to. It takes about 1 second for the
new file to show in Explorer, processing a 5000-line
file. And that's with VBS -- interpreted code restricted
to variant data type. ... So you might want to test your
basic sort routine on your biggest job before you get
into stuff like swapping string pointers.

--
--
"BeeJ" <nospam@spamnot.com> wrote in message
news:j4bv46$4g6$1@dont-email.me...
|I have a sort routine that I wrote to sort types however it is not as
| fast as I would like. My routine does it the hard way and moves each
| part around. It works but I think it could be faster if it used
| pointers instead. I have seen and tried to modify sort routines that
| swap pointers but it always crashes.
|
| This is a typical type array that I need to sort.
|
| Public Type DataType
| sKey as String
| sItem as String
| lIndex as Long
| End Type
| Public tData() as DataType
|
| I would like to have a Sort routine like this:
|
| Public Function Sort(tArr() as DataType, lElement as Long) as Boolean
|
| ' this would sort on the lElement of the type.
| ' so it lElement = 0 then the sort would work on sKey, etc
|
| End Function 'Sort
|
| Any pointers (lol) would be helpful.
| I tried searching for VB6 Sort Type but got nothing using Types.
|
|

ralph

9/9/2011 3:34:00 PM

On Thu, 08 Sep 2011 19:53:47 -0700, BeeJ <nospam@spamnot.com> wrote:

>I have a sort routine that I wrote to sort types however it is not as
>fast as I would like. My routine does it the hard way and moves each
>part around. It works but I think it could be faster if it used
>pointers instead. I have seen and tried to modify sort routines that
>swap pointers but it always crashes.
>
>This is a typical type array that I need to sort.
>
>Public Type DataType
> sKey as String
> sItem as String
> lIndex as Long
>End Type
>Public tData() as DataType
>
>I would like to have a Sort routine like this:
>
>Public Function Sort(tArr() as DataType, lElement as Long) as Boolean
>
> ' this would sort on the lElement of the type.
> ' so it lElement = 0 then the sort would work on sKey, etc
>
>End Function 'Sort
>
>Any pointers (lol) would be helpful.
>I tried searching for VB6 Sort Type but got nothing using Types.
>

In these situations you might also consider taking another approach.

Instead of collecting a bag of stuff and then sorting it, you might
take a look at a storage mechanism to sort items as they are
collected. A B-Tree for example.

Other stuff:

While it is common practice to use the term "pointer" to refer to
references, the term is more accurately applied to a specific data
type which supports arithmetic and dereferencing addresses - VB does
NOT support pointers. (Your 'crashes' come at no surprise) It does
support References.

If you want 'speed' in VB look for ways to "swap references".

VB also supports objects. Practically everything in VB is an object.
One notable exception is the VB Type. VB Types are bit of a hack
thrown in to support communication with an essentially "C" WinAPI.
They make very convenient storage to package related items but can
cumbersome when it comes to manipulating those items in VB.

[If you have to work with 'Types' and want to improve performance
dramatically you might consider using an external library written in
C/C++ to perform the sorts.]

Often a context in which we might think an array of Types as the
simplest solution is better resolved in VB by using one or more
objects with VB Arrays as the internal storage. VB does VB Arrays with
VB objects very well.

In other words less data-centric and more object-centric.

-ralph

(nobody)

9/9/2011 3:46:00 PM

"BeeJ" <nospam@spamnot.com> wrote in message
news:j4bv46$4g6$1@dont-email.me...
>I have a sort routine that I wrote to sort types however it is not as fast
>as I would like. My routine does it the hard way and moves each part
>around. It works but I think it could be faster if it used pointers
>instead. I have seen and tried to modify sort routines that swap pointers
>but it always crashes.
>
> This is a typical type array that I need to sort.
>
> Public Type DataType
> sKey as String
> sItem as String
> lIndex as Long
> End Type
> Public tData() as DataType
>
> I would like to have a Sort routine like this:
>
> Public Function Sort(tArr() as DataType, lElement as Long) as Boolean
>
> ' this would sort on the lElement of the type.
> ' so it lElement = 0 then the sort would work on sKey, etc
>
> End Function 'Sort
>
> Any pointers (lol) would be helpful.
> I tried searching for VB6 Sort Type but got nothing using Types.

The way I am dealing with sorting ListView columns of different types is by
substituting the typical comparison in sort routines with a function call
that has the same return value as StrComp() function. I am also using Enum
to represent the columns in the ListView for easy coding. Also, rather than
swapping the elements in an array, I am swapping the indices to these
elements, and accessing the array through a Sorted() array that only contain
Long variables. For example, instead of:

Debug.Print sFileName(i)

I use this almost everywhere:

Debug.Print sFileName(Sorted(i))

Sorted is defined like this:

Private Sorted() As Long

It's initialized sequentially in the beginning, and so by default, the files
are shown unsorted. Here is some sample code:

' ListView columns
Private Enum enumListViewColumns
lvcFileName
lvcFileType
lvcFileSize
lvcFileLastModifiedDate
End Enum

' Sorting Modes: Ascending/Descending
Private Enum enumListViewSortModes
lvsAscending = 0
lvsDescending = 1
End Enum

' Current View of the ListView, such as which column is sorted, and
' the sorting order
'
Private Type TCurView
SortBy As enumListViewColumns ' -1 means not sorted
SortOrder As enumListViewSortModes
End Type

Private CurView As TCurView

'
' GetSortingResult
'
' Returns the same value as StrComp() function.
Private Function GetSortingResult(ByVal i1 As Long, ByVal i2 As Long, _
Optional ByVal CompareMethod As VbCompareMethod = vbTextCompare) As Long

Dim ret As Long

Select Case CurView.SortBy
Case lvcFileName, lvcFileType:
' String sort
ret = GetSortingStrResult(i1, i2, CompareMethod)
Case lvcFileSize, lvcFileLastModifiedDate:
' Numeric sort
ret = GetSortingNumericResult(i1, i2)
Case -1: ' Unsorted
GetSortingResult = 0
Exit Function
End Select

If CurView.SortOrder = cblvsAscending Then
GetSortingResult = ret
Else
GetSortingResult = -ret
End If

End Function

'
' GetSortingStrResult
'
' String comparison
Private Function GetSortingStrResult(ByVal i1 As Long, ByVal i2 As Long, _
Optional ByVal CompareMethod As VbCompareMethod = vbTextCompare) As Long
Dim ret As Long

Select Case CurView.SortBy
Case lvcFileName
ret = StrComp(ListItemData(i1).FileName, _
ListItemData(i2).FileName, CompareMethod)
Case lvcFileType
ret = StrComp(ListItemData(i1).FileType, _
ListItemData(i2).FileType, CompareMethod)
End Select
GetSortingStrResult = ret

End Function

'
' GetSortingNumericResult
'
' Numeric comparison
Private Function GetSortingNumericResult(ByVal i1 As Long, _
ByVal i2 As Long) As Long
Dim ret As Long

Select Case CurView.SortBy
Case lvcFileSize
If ListItemData(i1).FileSize > ListItemData(i2).FileSize Then
ret = 1
ElseIf ListItemData(i1).FileSize < ListItemData( _
i2).FileSize Then
ret = -1
Else
ret = 0
End If
Case lvcFileLastModifiedDate
If ListItemData(i1).LastModifiedDate > ListItemData( _
i2).LastModifiedDate Then
ret = 1
ElseIf ListItemData(i1).LastModifiedDate < ListItemData( _
i2).LastModifiedDate Then
ret = -1
Else
ret = 0
End If
End Select
GetSortingNumericResult = ret

End Function

While I could have moved some of the code to GetSortingResult() from the
other comparison routines, in my real case I have to check for other
conditions, and they are bigger than what appears here.

The sorting routine that I used is ShuttleMergeSortS() from the link
below(Even for non-String data types). It's a general fast stable sort
routine that is close to the speed of QuickSort, but doesn't use recursion.
QuickSort routines are generally not stable routines(but there are
implementations that are), which is important for the typical sort by column
for ListViews. See here if you don't know what a stable sort is:

http://en.wikipedia.org/wiki/Sorting_algorithm...

Basically, if the sort is unstable, your ListView rows seem to jump up and
down if the column you are sorting by happen to contain some equal values.
The user would notice that other columns go up and down. This is noticeable
if you are showing live data that you update from a Timer, but for a list of
files, it's not noticeable, unless you are doing what Explorer does, showing
recently added files, and assuming that you are resorting to show them in
the proper location. Here is a link to the sorting routine which I am using:

ShuttleMergeSort - An improved MergeSort
http://www.devx.com/vb2themax...

You would need to make these 5 modifications to call GetSortingResult()
above, so the sorting is done regardless of the data type, and you have one
sort routine only. Here are these modifications:

1 - Remove A() As String parameter, and add this at the end:

Optional ByVal CompareMethod As VbCompareMethod = vbTextCompare

2 - Comment out the following line, and the two places where this variable
appears in the code(This would improve speed a bit):

Dim TMP As String

3 - Replace this:

If TMP < A(P(LP - 1)) Then P(LP) = P(LP - 1) Else Exit For

With this:

If GetSortingResult(OP, p(lp - 1), CompareMethod) < 0 Then p(lp) = p(lp - 1)
Else Exit For

4 - Replace this:

If A(P(LP)) <= A(P(RP)) Then

With this:

If GetSortingResult(P(LP), P(RP), CompareMethod) <= 0 Then

5 - Replace this:

If A(Q(LP)) <= A(Q(RP)) Then

With this:

If GetSortingResult(Q(LP), Q(RP), CompareMethod) <= 0 Then

Finally, whether you modify the sort routine or not, you need to give it a
sequential array before calling it. Example:

Private Sub ReSortListView()
Dim i As Long

' Initialize the indexing array
For i = 1 To ListView1.ListItems.Count
Sorted(i) = i
Next

ShuttleMergeSortS 1, ListView1.ListItems.Count, Sorted
End Sub

Article by the author:

A Comparison of Sorting Algorithms
http://www.devx.com/vb2themax/Art...

(nobody)

9/9/2011 4:30:00 PM

"Nobody" <nobody@nobody.com> wrote in message
news:j4dcb6$4kg$1@speranza.aioe.org...
> ShuttleMergeSort - An improved MergeSort
> http://www.devx.com/vb2themax...

Here is code to test that routine with random Strings and Longs, and
verifies the sort result and prints any discrepancies. I found problems with
the Long version, but not the String version:

Option Explicit

Private Declare Sub OutputDebugString Lib "kernel32" Alias _
"OutputDebugStringA" (ByVal lpOutputString As String)

Private Sub Command1_Click()
Const LO As Long = 1
Const HI As Long = 1000000
Dim S1(LO To HI) As String
Dim S1Index(LO To HI) As Long
'Dim P2(Lo To Hi) As Long
Dim L1(LO To HI) As Long
Dim L1Index(LO To HI) As Long
Dim Q(LO To HI) As Long
Dim I As Long
Dim t As Single

Randomize

For I = LO To HI
S1(I) = Format(Int((HI * Rnd) + LO), "000000000")
'Debug.Print i, "'"; S1(i); "'"
S1Index(I) = I
'P2(i) = i
L1(I) = Int((HI * Rnd) + LO)
L1Index(I) = I
Next

' Start String sort
t = Timer
pShuttleMergeSortS LO, HI, S1, S1Index, Q
DebugPrint "String sort: Time taken " & Timer - t

' Start Long sort
t = Timer
ShuttleMergeSortL LO, HI, L1, L1Index
DebugPrint "Long sort: Time taken " & Timer - t

' Print some values

For I = LO To IIf(HI > 30, 30, HI)
DebugPrint I & ", " & S1Index(I) & ", " & "'" & S1( _
I) & "'" & ", " & "'" & S1(S1Index(I))
Next

For I = LO To IIf(HI > 30, 30, HI)
DebugPrint I & ", " & "'" & L1(I) & "'" & L1Index(I) & ", " & L1( _
L1Index(I))
Next

' Verify String sort
For I = LO To HI - 1
If S1(S1Index(I)) > S1(S1Index(I + 1)) Then
DebugPrint "Incorrect String sort at " & I & ", " & S1Index( _
I) & ", " & "'" & S1(S1Index(I)) & "'"
End If
Next

' Verify Long sort
For I = LO To HI - 1
If L1(L1Index(I)) > L1(L1Index(I + 1)) Then
DebugPrint "Incorrect Long sort2 at " & I & ", " & L1Index( _
I) & ", " & L1Index(I + 1) & ", " & "'" & L1(L1Index( _
I)) & "'" & ", " & "'" & L1(L1Index(I + 1))
End If
Next

End Sub

Private Sub DebugPrint(ByRef MSG As String)
Debug.Print MSG
OutputDebugString MSG & vbCrLf
End Sub

It took 2.5936 Seconds to sort 1,000,000 random Strings in the EXE. With all
advanced compilation options enabled and Pentium Pro, I got 2.4056 Seconds.
This is on XP+SP2 and Intel Core2 Quad 2.4 GHz.

For 100,000 random Strings, I got 0.1715 and 0.15575 Seconds respectively.

BeeJ

9/9/2011 10:07:00 PM

The code below is what I mean by a "pointer" swap sort.
I have already, months ago, looked at all the references given so far
and none do a "pointer" swap sort on a UDT, AFAIK.
I have tried the parallel index swap sort for strings and have also
written a UDT sort that swaps each item (i.e. copy to sTemp, sTemp to
....) and it is fairly fast but not what I hoped for. I will study what
Nobody presented in his two recent posts.

' =========================================================
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (Ptr() As
Any) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (Dst As Any, Src As
Any, ByVal cb As Long)

Public Sub QSort(asArray() As DataType)

' QSort String-Arrays

Dim lIXx As Long
Dim lIXy As Long
Dim lPtrLo As Long
Dim lPtrHi As Long
Dim lPtrStr As Long
Dim lPtr As Long
Dim lStSize As Long

Dim asV(0) As String
Dim alpV() As Long
Dim alsapV(5) As Long
Dim alPArr() As Long
Dim alsaPArr(5) As Long
Dim alStLo() As Long
Dim alStHi() As Long

lStSize = 255
ReDim alStLo(lStSize)
ReDim alStHi(lStSize)

alsaPArr(0) = 1
alsaPArr(1) = 4 ' initialize StrPtr-Arrays for fast swap
alsaPArr(3) = VarPtr(asArray(0))
alsaPArr(4) = UBound(asArray) + 1
RtlMoveMemory ByVal ArrPtr(alPArr), VarPtr(alsaPArr(0)), 4
'
alsapV(0) = 1
alsapV(1) = 4
alsapV(3) = VarPtr(asV(0))
alsapV(4) = 1
RtlMoveMemory ByVal ArrPtr(alpV), VarPtr(alsapV(0)), 4

alStLo(0) = LBound(asArray)
alStHi(0) = UBound(asArray)
lPtrStr = 1
Do
lPtrStr = lPtrStr - 1
lPtrLo = alStLo(lPtrStr)
lPtrHi = alStHi(lPtrStr)
If lPtrHi - lPtrLo < 12 Then '
For lPtrLo = lPtrLo To lPtrHi - 1
lIXy = lPtrLo
For lIXx = lPtrLo + 1 To lPtrHi
If asArray(lIXx).sKey < asArray(lIXy).sKey Then
lIXy = lIXx
End If
Next lIXx
If lIXy <> lPtrLo Then
lPtr = alPArr(lIXy)
alPArr(lIXy) = alPArr(lPtrLo)
alPArr(lPtrLo) = lPtr
End If

Next lPtrLo

Else 'QSort
Do
lIXx = lPtrLo
lIXy = lPtrHi
alpV(0) = alPArr((lPtrLo + lPtrHi) \ 2)
Do
Do While asArray(lIXx).sKey < asV(0)
lIXx = lIXx + 1
Loop
Do While asArray(lIXy).sKey > asV(0)
lIXy = lIXy - 1
Loop
If lIXx <= lIXy Then
lPtr = alPArr(lIXx)
alPArr(lIXx) = alPArr(lIXy)
alPArr(lIXy) = lPtr
lIXx = lIXx + 1
lIXy = lIXy - 1
End If

Loop While lIXx <= lIXy

If lIXy - lPtrLo < lPtrHi - lIXx Then
If lIXx < lPtrHi Then
alStLo(lPtrStr) = lIXx
alStHi(lPtrStr) = lPtrHi
lPtrStr = lPtrStr + 1
If lPtrStr >= lStSize Then
lStSize = lStSize + lStSize
ReDim Preserve alStLo(lStSize)
ReDim Preserve alStHi(lStSize)
End If
End If
lPtrHi = lIXy

Else
If lPtrLo < lIXy Then
alStLo(lPtrStr) = lPtrLo
alStHi(lPtrStr) = lIXy
lPtrStr = lPtrStr + 1
If lPtrStr >= lStSize Then
lStSize = lStSize + lStSize
ReDim Preserve alStLo(lStSize)
ReDim Preserve alStHi(lStSize)
End If
End If
lPtrLo = lIXx

End If

Loop While lPtrLo < lPtrHi

End If

Loop While lPtrStr

RtlMoveMemory ByVal ArrPtr(alPArr), 0&, 4
alpV(0) = 0
RtlMoveMemory ByVal ArrPtr(alpV), 0&, 4

End Sub 'QSort

' =========================================================

ralph

9/10/2011 5:29:00 AM

On Fri, 09 Sep 2011 15:07:22 -0700, BeeJ <nospam@spamnot.com> wrote:

>The code below is what I mean by a "pointer" swap sort.
> <snipped>

I'm absolutely speechless.

(Which many will verify is a good thing. <g>)

-ralph

(nobody)

9/10/2011 12:46:00 PM

"BeeJ" <nospam@spamnot.com> wrote in message
news:j4e2ms$138$1@speranza.aioe.org...
> The code below is what I mean by a "pointer" swap sort.
> I have already, months ago, looked at all the references given so far and
> none do a "pointer" swap sort on a UDT, AFAIK.
> I have tried the parallel index swap sort for strings and have also
> written a UDT sort that swaps each item (i.e. copy to sTemp, sTemp to ...)
> and it is fairly fast but not what I hoped for. I will study what Nobody
> presented in his two recent posts.

Pointer swap would have the same speed as Index swap. Both are 32-Bit Long
swap instead of swapping the actual String or UDT. Also, the routine I
posted the link to does Insertion sort first, which is faster than QuickSort
for mostly sorted arrays. So if you are sorting, then make minor changes,
then sort again, it would be faster the second time.

BeeJ

9/10/2011 4:42:00 PM

Nobody brought next idea :
> "BeeJ" <nospam@spamnot.com> wrote in message
> news:j4e2ms$138$1@speranza.aioe.org...
>> The code below is what I mean by a "pointer" swap sort.
>> I have already, months ago, looked at all the references given so far and
>> none do a "pointer" swap sort on a UDT, AFAIK.
>> I have tried the parallel index swap sort for strings and have also written
>> a UDT sort that swaps each item (i.e. copy to sTemp, sTemp to ...) and it
>> is fairly fast but not what I hoped for. I will study what Nobody
>> presented in his two recent posts.
>
> Pointer swap would have the same speed as Index swap. Both are 32-Bit Long
> swap instead of swapping the actual String or UDT. Also, the routine I posted
> the link to does Insertion sort first, which is faster than QuickSort for
> mostly sorted arrays. So if you are sorting, then make minor changes, then
> sort again, it would be faster the second time.

I will seriously look at this as soon as I get a chance.
Thans!

microsoft.public.vb.general.discussion

Sort Type

BeeJ

Mike Scirocco

David Kaye

Mayayana

ralph

(nobody)

(nobody)

BeeJ

ralph

(nobody)

BeeJ

x Login to ForumsZone