String Sorter, anyone have one?

[axipher]

Hey yall, does anyone have a way to sort strings in terms of alphabetical order, like in a dictionary?

[MichaelW]

This is a quick example converted from a QB app. It uses a very simple recursive Quick sort that is not suitable for anything serious because non-random sort data can cause it to run very slow and/or trigger a stack overflow. If you are doing something serious then you should probably use the CRT qsort function.

Code: Select all

sub QuickSortStr( low as integer,high as integer,array() as string )

  dim as string pivot
  dim as integer i,j
  i = low
  j = high

  pivot = array((low + high) \ 2)

  do
    do while (i < high) and (array(i) < pivot)
      i += 1
    loop
    do while (j > low) and (pivot < array(j))
      j -= 1
    loop
    if i <= j then
      swap array(i), array(j)
      i += 1
      j -= 1
    end if

  loop while i <= j

  if low < j then QuickSortStr low, j, array()
  if i < high then QuickSortStr i, high, array()

end sub

dim as integer i,j
dim as string temp, array(1 TO 10000)

for i = 1 to 10000
    temp = ""
    for j = 1 to 10
        temp = temp + chr(asc("a") + rnd * 25)
    next
    array(i) = temp
next

for i = 50 to 10000 step 200
    print i, array(i)
next

sleep
print

QuickSortStr lbound(array), ubound(array), array()

for i = 50 to 10000 step 200
    print i, array(i)
next

sleep

[ytwinky]

Hi,
you could also use QSort.Bas
It uses Pointers
..you may sort up- and downwards
..most of it is in english :D
regards
ytwinky

[yetifoot]

Heres a non recusive one, i got from Ethan Winers book.

Code: Select all

Sub QuickSort(ArrayToSort() As String, ByVal StartEl As Integer, ByVal NumEls As Integer)
'************************************************************
'Standard Non-Recursive QuickSort Routine
'************************************************************
  Dim As String Temp
  Dim As Integer First, Last, i, j, StackPtr
  Redim As Integer QStack(NumEls \ 5 + 10)
    First = StartEl
    Last = StartEl + NumEls - 1
    Do
      Do
        Temp = ArrayToSort((Last + First) \ 2)
        i = First
        j = Last
        Do
          While ArrayToSort(i) < Temp   ' Swap < for > to do in descending order
            i = i + 1
          Wend
          While ArrayToSort(j) > Temp   ' Swap > for < to do in descending order
            j = j - 1
          Wend
          If i > j Then Exit Do
          If i < j Then Swap ArrayToSort(i), ArrayToSort(j)
          i = i + 1
          j = j - 1
        Loop While i <= j
        If i < Last Then
          QStack(StackPtr) = i
          QStack(StackPtr + 1) = Last
          StackPtr = StackPtr + 2
        End If
        Last = j
      Loop While First < Last
      If StackPtr = 0 Then Exit Do
      StackPtr = StackPtr - 2
      First = QStack(StackPtr)
      Last = QStack(StackPtr + 1)
    Loop
  Erase QStack
End Sub 

' Quick test

Dim As String str_array(0 To 4)
Dim As Integer i

str_array(0) = "Zob"
str_array(1) = "Bob"
str_array(2) = "Hello"
str_array(3) = "Job"
str_array(4) = "Fob"

QuickSort(str_array(), 0, 5)

For i = 0 To 4
  Print str_array(i)
Next i

[yetifoot]

And heres an example using the crt qsort function.

Code: Select all

#include "crt.bi"

Function Sort_Callback Cdecl (ByVal s1 As Any ptr, ByVal s2 As Any ptr) As Integer

  Dim As String ptr a = s1, b = s2
  
    If *a < *b Then     ' Swap < for > for descending
      Return -1
    ElseIf *a > *b Then ' Swap > for < for descending
      Return 1
    End If
    
    Return 0
    
End Function

' Quick test

Dim As String str_array(0 To 4)
Dim As Integer i

str_array(0) = "Zob"
str_array(1) = "Bob"
str_array(2) = "Hello"
str_array(3) = "Job"
str_array(4) = "Fob"

qsort(@str_array(0), 5, sizeof(string), @Sort_Callback)

For i = 0 To 4
  Print str_array(i)
Next i