| |
|
|
| Submitted on: 5/22/1998
By: Mike Shaffer
Level: Not Given
User Rating:
By 103 Users
Compatibility:VB 3.0, VB 4.0 (16-bit), VB 4.0 (32-bit), VB 5.0, VB 6.0
Users have accessed this code 11385 times.
| (About the author) |
| | | Want to sort 5,000 10-byte strings in about 1/10th of a second? This will do it (at least on my PII-233!). The insertion sort manages the same task in about 60 seconds (even when optimized it still took about 15 seconds on the same machine).
| | | | | code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
Terms of Agreement:
By using this code, you agree to the following terms...
1) You may use
this code in your own programs (and may compile it into a program and distribute it in compiled format for languages that allow it) freely and with no charge.
2) You MAY NOT redistribute this code (for example to a web site) without written permission from the original author. Failure to do so is a violation of copyright laws.
3) You may link to this code from another website, but ONLY if it is not wrapped in a frame.
4) You will abide by any additional copyright restrictions which the author may have placed in the code or code's description. |
'**************************************
' Name: qsort
' Description:Want to sort 5,000 10-byte
' strings in about 1/10th of a second? Thi
' s will do it (at least on my PII-233!).
' The insertion sort manages the same task
' in about 60 seconds (even when optimized
' it still took about 15 seconds on the sa
' me machine).
' By: Mike Shaffer
'
' Inputs:strList (a string array)
'
' Returns:strList (the same array - sort
' ed)
'
' Assumes:Want to sort 5,000 10-byte str
' ings in about 1/10th of a second? This w
' ill do it (at least on my PII-233!). The
' insertion sort manages the same task in
' about 60 seconds (even when optimized it
' still took about 15 seconds on the same
' machine).
'
'This code is copyrighted and has' limited warranties.Please see http://w
' ww.Planet-Source-Code.com/vb/scripts/Sho
' wCode.asp?txtCodeId=897&lngWId;=1'for details.'**************************************
Public Function QSort(strList() As String, lLbound As Long, lUbound As Long)
':::::::::::::::::::::::::::::::::::::::
' ::::::::::::::::::::::::::::::'
'::::::'
'::: Routine:QSort :::'
'::: Author:Mike Shaffer (after Rod Step
' hens, et al.) :::'
'::: Date: 21-May-98 :::'
'::: Purpose:Very fast sort of a string
' array :::'
'::: Passed:strListString array:::'
'::: lLboundLower bound to sort (usually
' 1) :::'
'::: lUboundUpper bound to sort (usually
' ubound()) :::'
'::: Returns:strList(in sorted order):::
'
'::: Copyright: Copyright *c* 1998, Mike
' Shaffer :::'
'::: ALL RIGHTS RESERVED WORLDWIDE :::'
'::: Permission granted to use in any no
' n-commercial:::'
'::: product with credit where due. For
' free:::'
'::: commercial license contact mshaffer
' @nkn.net:::'
'::: Revisions: 22-May-98 Added and then
' dropped revision :::'
'::: using CopyMemory rather than the si
' mple swap :::'
'::: when it was found to not provide mu
' ch benefit.:::'
'::::::'
':::::::::::::::::::::::::::::::::::::::
' ::::::::::::::::::::::::::::::'
Dim strTemp As String
Dim strBuffer As String
Dim lngCurLow As Long
Dim lngCurHigh As Long
Dim lngCurMidpoint As Long
lngCurLow = lLbound' Start current low and high at actual low/high
lngCurHigh = lUbound
If lUbound <= lLbound Then Exit Function ' Error!
lngCurMidpoint = (lLbound + lUbound) \ 2 ' Find the approx midpoint of the array
strTemp = strList(lngCurMidpoint) ' Pick as a starting point (we are making
' an assumption that the data *might* be
'
' in semi-sorted order already!
Do While (lngCurLow <= lngCurHigh)
Do While strList(lngCurLow) < strTemp
lngCurLow = lngCurLow + 1
If lngCurLow = lUbound Then Exit Do
Loop
Do While strTemp < strList(lngCurHigh)
lngCurHigh = lngCurHigh - 1
If lngCurHigh = lLbound Then Exit Do
Loop
If (lngCurLow <= lngCurHigh) Then ' if low is <= high then swap
strBuffer = strList(lngCurLow)
strList(lngCurLow) = strList(lngCurHigh)
strList(lngCurHigh) = strBuffer
'
lngCurLow = lngCurLow + 1 ' CurLow++
lngCurHigh = lngCurHigh - 1' CurLow--
End If
Loop
If lLbound < lngCurHigh Then ' Recurse if necessary
QSort strList(), lLbound, lngCurHigh
End If
If lngCurLow < lUbound Then' Recurse if necessary
QSort strList(), lngCurLow, lUbound
End If
End Function
| | | | | Report Bad Submission | | | | | Your Vote! | |
See Voting Log | | | | Other User Comments | 8/30/1999 7:55:00 AM:alfonso
wow ! so many downloaders
| 11/2/1999 11:42:00 PM:clinton
Is there a way of sorting without using
an array.
I need to sort 17 million
strings from a file????????????
| 12/29/1999 2:29:05 PM:Mike Shaffer
To 'clinton'... to sort large amount of
data you would probably want to do some
variation of a merge sort... this is
where you read a subset of the data and
sort it, saving the results to a disk
file, then do the next 'subset', then
the next, until you're done with all of
the subsets. Then you read records from
all of the small sorted 'piles' and
write them to the new, fully sorted
file. It's a little too much detail to
place in a comment here, but search the
web under 'merge sort' and/or 'heap
sort' and you will find all the info
you need. If you like, I can help with
source code for this type of sort.
| 6/5/2000 10:46:50 AM:tOm
hi!
i have a question. the array i
need to be sorted is a userdefined
type, how can i use qsort in order to
sort this?
thx,
.tOm
| 10/17/2000 9:14:01 PM:Kamilche
Man! That's one fast, small sort!
Thanks for the source. :-)
| 5/30/2001 4:17:08 PM:Liquid Khaos
The following code returns an
incorrectly sorted array, what am I
doing wrong?
Public Function foo()
Dim xx() As Variant
xx =
Array("fred", "dino", "Wilma",
"barney", "Alex")
Debug.Print " "
Debug.Print
"Before sort"
Debug.Print "1 ";
xx(0)
Debug.Print "2 "; xx(1)
Debug.Print "3 "; xx(2)
Debug.Print "4 "; xx(3)
Debug.Print "5 "; xx(4)
Debug.Print " "
QSort xx,
LBound(xx), UBound(xx)
Debug.Print "after sort"
Debug.Print "1 "; xx(0)
Debug.Print "2 "; xx(1)
Debug.Print "3 "; xx(2)
Debug.Print "4 "; xx(3)
Debug.Print "5 "; xx(4)
End
Function
Return results:
Before
sort
1 fred
2 dino
3 Wilma
4
barney
5 Alex
after sort
1
Alex
2 Wilma
3 barney
4 dino
5
fred
| 7/1/2001 3:55:20 AM:Philippe Lord
I have created a much faster sort
algorithm and I have posted it too.
It's a 3-median QuickSort combined with
an insertionSort
I've benchmarked
against standard QuickSorts, such as
this one, and it manages to get from
15% to 30% faster than yours. I've
spent lots of efforts creating it.
Another note: QuickSort suffers from
nearly-sorted arrays, a 3-median
quicksort does not
;)
check
http://www.planetsourcecode
.com/xq/ASP/txtCodeId.24546/lngWId.1/qx/
vb/scripts/ShowCode.htm
It does far
more than just sorting..
| 7/18/2001 9:24:33 PM:Rish
This code is PATHETIC, does NOT work
correctly.
| 7/18/2001 11:56:44 PM:mshaffer
Interesting comment by Rish, and
probably highly disrespectful, but I
doubt it's correct, since I use it in
dozens of programs that run every day,
and have for years, and I have received
literally HUNDREDS of "thank you's"
from people who have used this code and
found it to be useful. Perhaps "Rish"
does not understand how to use it? I
would be happy to help, and often DO
help people I do not even know, but I
do not believe that people with this
attitude CAN be helped, as they
obviously already know everything. ;-)
| 7/19/2001 12:06:47 AM:mshaffer
To Liquid Khaos,
Sorry, I was not
aware of your comment earlier, but the
sort uses standard ASCII collating
sequences to sort your data, and in the
ASCII sorting sequence, UPPER case
letters come before lower case letters,
so any word starting with an upper case
letter will come before the same word
that starts with a lower case letter.
To make the sort case insensitive, do
the compare with a UCASE (or an lcase)
function. It really makes no difference
which one you use, as long as you're
consistent. I hope this helps! ;-)
| 7/19/2001 12:10:27 AM:mshaffer
To Philippe,
Sounds cool! I have
also created much faster sorts
(including a skip sort that performs
approximately 5-times faster on
truly-non-ordered data), however I am
not allowed to post it here due to
intellectual property laws (I created
it while under contract to a
notoriously secrecy-minded company)
;-)
| 8/15/2001 3:20:34 PM:Rhett Micheletti
Mike,
Thanks for you code. I cannot
vouch for it yet since I have not yet
tried it, but regardless, thank you for
sharing your work. I think you summed
up 'Rish' quite nicely.
Don't ever
let the 'Rishes' (the bitter, jealous,
and petty little people of the world
ever get you down!
Keep on
codin'
Warm Regards,
Rhett
Micheletti
| | | Add Your Feedback! | Note:Not only will your feedback be posted, but an email will be sent to the code's author in your name.
NOTICE: The author of this code has been kind enough to share it with you. If you have a criticism, please state it politely or it will be deleted.
For feedback not related to this particular code, please click here.
| |
|
