Re: Sorting of Sorts

From: BeastFish (beastfish_at_for-president.com)
Date: 04/11/04 

Date: Sun, 11 Apr 2004 19:52:46 -0400

Don,

Here's one of the quickest BASIC sorts I've seen (HuthSort). Sorts a 20,000
word list in about a second:

Private Type StackType
  low As Integer
  hi As Integer
End Type

Sub HuthSort(arry() As String)
   ' Iterative QuickSort by Cornel Huth
    Dim compare As String, holdd As String
    Dim low As Long, hi As Long, md As Long
    Dim StackPtr As Integer, i As Integer, j As Integer

    Dim aStack(1 To 128) As StackType

    StackPtr = 1
    aStack(StackPtr).low = LBound(arry)
    aStack(StackPtr).hi = UBound(arry)
    StackPtr = StackPtr + 1

    Do
      StackPtr = StackPtr - 1
      low = aStack(StackPtr).low
      hi = aStack(StackPtr).hi
      Do
        i = low
        j = hi
        md = (low + hi) \ 2
        compare = arry(md)
        Do
          Do While arry(i) < compare
            i = i + 1
          Loop
      Do While arry(j) > compare
            j = j - 1
          Loop
          If i <= j Then
            holdd = arry(i)
            arry(i) = arry(j)
            arry(j) = holdd
            i = i + 1
            j = j - 1
          End If
        Loop While i <= j
        If j - low < hi - i Then
          If i < hi Then
            aStack(StackPtr).low = i
            aStack(StackPtr).hi = hi
            StackPtr = StackPtr + 1
          End If
          hi = j
        Else
          If low < j Then
            aStack(StackPtr).low = low
            aStack(StackPtr).hi = j
            StackPtr = StackPtr + 1
          End If
          low = i
        End If
      Loop While low < hi
    Loop While StackPtr <> 1
End Sub

To sort by word length, perhaps you can modify a shell sort or something...

Sub ShellSort(arry() As String)
    Dim Max As Integer, L9 As Integer, L8 As Integer
    Dim Gap As Integer, S As String

    Max = UBound(arry)
    Gap = Int(Max / 2) + 1
    While Gap > 0
       For L9 = 1 To Max - Gap
           For L8 = L9 To 1 Step -Gap
'' If arry(L8) > arry(L8 + Gap) Then
' If StrComp(arry(L8), arry(L8 + Gap), 1) = 1 Then
               If Len(arry(L8)) > Len(arry(L8 + Gap)) Then
                  holdd = arry(L8)
                  arry(L8) = arry(L8 + Gap)
                  arry(L8 + Gap) = holdd
                Else
                  L8 = 0
               End If
           Next
       Next
       Gap = Gap \ 2
    Wend
End Sub

<Don@home.com> wrote in message
news:6tsi70lbrf2m3unh1il68c732bl0obglpe@4ax.com...
> Thanks Vikram,
> I have tried your code and run into a time problem..
> There are 18000+ words in my word list...
> Due to the multipul passes it takes forever and then some...
> Thanks again...

> >Don@home.com wrote in message
news:<ip1g701fa7ujk443f2brrojqlnl76cni96@4ax.com>...
> >> Hi all,
> >> Sorting Ascending/Descending is rudimentary to say the least...
> >> I'm trying to build a word list from documents and I need to do the
following
> >> types of sorts:
> >> 1) Ascending (not much of a problem here)
> >> And then
> >> 2) By word length........................
> >> (or vis a vis)
> >>
> >> Any help here?¿?
> >>
> >> Have a good day...
> >>
> >> Don
>

Relevant Pages

  • Project Error
    ... Private Declare Sub Sleep Lib "Kernel32" ... Dim strDataSrc As String ...
    (microsoft.public.vb.bugs)
  • Re: Is there a way to prevent a RichTextBox from scrolling?
    ... Private _isRegex As Boolean ... Public Sub New(ByVal thispattern As String, ... Dim entry As tDict ...
    (microsoft.public.dotnet.framework.windowsforms.controls)
  • Excel Listing tool using VB
    ... Sub ListFiles2() ... Dim directories() As String, CurrentDirectory As String ... Dim dirtopaste, dirok ...
    (microsoft.public.vb.general.discussion)
  • Form Error
    ... SMSDS_CallerID As String ... Private Declare Sub Sleep Lib "kernel32" ... Dim ComString As String ... Dim AppPath As String, FreeFileNo% ...
    (microsoft.public.vb.bugs)
  • Re: Encrypt/hide Password
    ... Public Sub New(ByVal strCryptoName As String) ... ' instantiated crypto class. ... Dim fsKey As New FileStream(strSaveToPath, FileMode.OpenOrCreate, _ ...
    (microsoft.public.scripting.wsh)