When I found this thread, I was looking for an easy way out
of writing yet another special purpose sort. I tried this
code and it did not work correctly.
In doing more research, I found a site with many table sort
algorithms gathered together with both code and animation of
each of the methods.
It turns out that the thread code provided has a line out of
sequence.
I converted the QuickSort algorithm code of this site
from Java to Visual Basic and tested it, and corrected the
bubble sort code of the thread.
For a sort of 3000 entries, bubble takes about 40 seconds on
my machine, and quicksort takes less than 1 second.
Other statistics for qsort, for a 1998-model w98pc with 128MB
of EDO ram (limited paging during execution):
20Krecs:1sec
50Krecs:4sec
80Krecs:10sec
120Krecs:12sec
150Krecs 17sec
250Krecs: 21sec
Another thing to keep in mind: this test program has the xx
array defined in the form_show procedure, so after all the
work is done, Basic must destroy the "stack" variables before
the form is written to the screen. With the 120Krec procedure,
this can take several minutes to complete. If you move this
definition to "module-level" then the form shows immediately,
but the application-destroy time is increased.
As far as patent and licenses are concerned, I will not provide
an opinion. My own language conversion work is free of any
charge. I have included the entire source from the source site,
including the license information. Use at your own discretion.



When I found this thread, I was looking for an easy way out
of writing yet another special purpose sort. I tried this
code and it did not work correctly.
In doing more research, I found a site with many table sort
algorithms gathered together with both code and animation of
each of the methods.
It turns out that the thread code provided has a line out of
sequence.
I converted the QuickSort algorithm code of this site
from Java to Visual Basic and tested it, and corrected the
bubble sort code of the thread.
For a sort of 3000 entries, bubble takes about 40 seconds on
my machine, and quicksort takes less than 1 second.
Other statistics for qsort, for a 1998-model w98pc with 128MB
of EDO ram (limited paging during execution):
20Krecs:1sec
50Krecs:4sec
80Krecs:10sec
120Krecs:12sec
150Krecs 17sec
250Krecs: 21sec
Another thing to keep in mind: this test program has the xx
array defined in the form_show procedure, so after all the
work is done, Basic must destroy the "stack" variables before
the form is written to the screen. With the 120Krec procedure,
this can take several minutes to complete. If you move this
definition to "module-level" then the form shows immediately,
but the application-destroy time is increased.
As far as patent and licenses are concerned, I will not provide
an opinion. My own language conversion work is free of any
charge. I have included the entire source from the source site,
including the license information. Use at your own discretion.



VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 4965
ClientLeft = 165
ClientTop = 450
ClientWidth = 11880
LinkTopic = "Form1"
ScaleHeight = 4965
ScaleWidth = 11880
StartUpPosition = 3 'Windows Default
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' quicksort in java retrieved from this site, and converted
' to visual basic
' contains demos and sources in java for many methods
' http://www.cs.ubc.ca/spider/harrison/Java/sorting-demo.html


'/*
' * @(#)QSortAlgorithm.java 1.6f 95/01/31 James Gosling
' *
' * Copyright (c) 1994-1995 Sun Microsystems, Inc. All Rights Reserved.
' *
' * Permission to use, copy, modify, and distribute this software
' * and its documentation for NON-COMMERCIAL or COMMERCIAL purposes and
' * without fee is hereby granted.
' * Please refer to the file http://java.sun.com/copy_trademarks.html
' * for further important copyright and trademark information and to
' * http://java.sun.com/licensing.html for further important licensing
' * information for the Java (tm) Technology.
' *
' * SUN MAKES NO REPRESENTATIONS OR WARRANTIES ABOUT THE SUITABILITY OF
' * THE SOFTWARE, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED
' * TO THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
' * PARTICULAR PURPOSE, OR NON-INFRINGEMENT. SUN SHALL NOT BE LIABLE FOR
' * ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
' * DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES.
' *
' * THIS SOFTWARE IS NOT DESIGNED OR INTENDED FOR USE OR RESALE AS ON-LINE
' * CONTROL EQUIPMENT IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE
' * PERFORMANCE, SUCH AS IN THE OPERATION OF NUCLEAR FACILITIES, AIRCRAFT
' * NAVIGATION OR COMMUNICATION SYSTEMS, AIR TRAFFIC CONTROL, DIRECT LIFE
' * SUPPORT MACHINES, OR WEAPONS SYSTEMS, IN WHICH THE FAILURE OF THE
' * SOFTWARE COULD LEAD DIRECTLY TO DEATH, PERSONAL INJURY, OR SEVERE
' * PHYSICAL OR ENVIRONMENTAL DAMAGE ("HIGH RISK ACTIVITIES"). SUN
' * SPECIFICALLY DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR
' * HIGH RISK ACTIVITIES.
' */
'
'/**
' * A quick sort demonstration algorithm
' * SortAlgorithm.java, Thu Oct 27 10:32:35 1994
' *
' * @author James Gosling
' * @version 1.6f, 31 Jan 1995
' */
'/**
' * 19 Feb 1996: Fixed to avoid infinite loop discoved by Paul Haeberli.
' * Misbehaviour expressed when the pivot element was not unique.
' * -Jason Harrison
' *
' * 21 Jun 1996: Modified code based on comments from Paul Haeberli, and
' * Peter Schweizer (Peter.Schweizer@mni.fh-giessen.de).
' * Used Daeron Meyer's (daeron@geom.umn.edu) code for the
' * new pivoting code. - Jason Harrison
' *
' * 09 Jan 1998: Another set of bug fixes by Thomas Everth (everth@wave.co.nz)
' * and John Brzustowski (jbrzusto@gpu.srv.ualberta.ca).
' */
'


Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(lpDest As Any, lpSource As Any, ByVal cbCopy As Long)




Private Sub Form_Load()
Dim lov As Long
Dim hiv As Long
Dim ix As Long
Dim xx(20000) As String ' anything up to 32000

Debug.Print "Generating Data " & UBound(xx), Now
PopulateArray xx
Debug.Print "data generated", Now

' BubbleSort xx

qsort xx(), LBound(xx), UBound(xx)
Debug.Print "sort Finished", Now
For ix = lov To hiv - 1
If xx(ix) > xx(ix + 1) Then
Debug.Print "seq-err " & ix
End If
Next
Debug.Print "Seq-check Finished", Now
End Sub

Sub SwapStrings(pbString1 As String, pbString2 As String)
Dim l_Hold As Long
CopyMemory l_Hold, ByVal VarPtr(pbString1), 4
CopyMemory ByVal VarPtr(pbString1), ByVal VarPtr(pbString2), 4
CopyMemory ByVal VarPtr(pbString2), l_Hold, 4
End Sub


Sub PopulateArray(varArray() As String)
Dim i As Long, j As Long
Dim l_Count As Long, lcStr As String

' Typical sorting routine
l_Count = UBound(varArray)
Randomize
lcStr = ""
For i = LBound(varArray) To l_Count
lcStr = ""
For j = 1 To 50
lcStr = lcStr + Chr$((Rnd(1) * 26) + 65)
Next
varArray(i) = lcStr
Next
End Sub

Sub BubbleSort(varArray() As String)
Dim i As Long
Dim l_Count As Long
Dim l_Swap As Boolean

l_Count = UBound(varArray)

l_Swap = True
Do While l_Swap
l_Swap = False
For i = 0 To l_Count - 1
If varArray(i) > varArray(i + 1) Then
l_Swap = True
SwapStrings varArray(i), varArray(i + 1)
End If
Next
Loop
End Sub



' void sort(int a[], int lo0, int hi0) throws Exception {
' int lo = lo0;
' int hi = hi0;
' pause(lo, hi);
' if (lo >= hi) {
' return;
' }
' else if( lo == hi - 1 ) {
' /*
' * sort a two element list by swapping if necessary
' */
' if (a[lo] > a[hi]) {
' int T = a[lo];
' a[lo] = a[hi];
' a[hi] = T;
' }
' return;
' }
'
Private Sub qsort(strArray() As String, loidx As Long, hiidx As Long)
Dim lo As Long
Dim hi As Long
Dim cntidx As Long

If loidx > hiidx Then Exit Sub
lo = loidx
hi = hiidx
cntidx = hi - lo + 1
If cntidx < 2 Then Exit Sub
If cntidx = 2 Then
If strArray(lo) > strArray(hi) Then
SwapStrings strArray(lo), strArray(hi)
End If
Exit Sub
End If

'
' /*
' * Pick a pivot and move it out of the way
' */
' int pivot = a[(lo + hi) / 2];
' a[(lo + hi) / 2] = a[hi];
' a[hi] = pivot;
'
Dim pivotloc As Long
Dim pivotval As String
pivotloc = (lo + hi) / 2
pivotval = strArray(pivotloc)
SwapStrings strArray(pivotloc), strArray(hi)

' while( lo < hi ) {
' /*
' * Search forward from a[lo] until an element is found that
' * is greater than the pivot or lo >= hi
' */
' while (a[lo] <= pivot && lo < hi) {
' lo++;
' }
'
loopagain:
If lo >= hi Then GoTo loopdone

Do While strArray(lo) <= pivotval
lo = lo + 1
If lo >= hi Then GoTo loopdone
Loop

' /*
' * Search backward from a[hi] until element is found that
' * is less than the pivot, or lo >= hi
' */
' while (pivot <= a[hi] && lo < hi ) {
' hi--;
' }
Do While pivotval <= strArray(hi)
hi = hi - 1
If lo >= hi Then GoTo loopdone
Loop

'
' /*
' * Swap elements a[lo] and a[hi]
' */
' if( lo < hi ) {
' int T = a[lo];
' a[lo] = a[hi];
' a[hi] = T;
' pause();
' }
SwapStrings strArray(lo), strArray(hi)
'
' if (stopRequested) {
' return;
' }
' }
GoTo loopagain
loopdone:
'
' /*
' * Put the median in the "center" of the list
' */
' a[hi0] = a[hi];
' a[hi] = pivot;
'
SwapStrings strArray(hiidx), strArray(hi)
strArray(hi) = pivotval
' /*
' * Recursive calls, elements a[lo0] to a[lo-1] are less than or
' * equal to pivot, elements a[hi+1] to a[hi0] are greater than
' * pivot.
' */
' sort(a, lo0, lo-1);
' sort(a, hi+1, hi0);

qsort strArray(), loidx, lo - 1
qsort strArray(), hi + 1, hiidx

' }
'
'
End Sub