## String Sorter, anyone have one?

New to FreeBASIC? Post your questions here.
axipher
Posts: 891
Joined: Dec 27, 2005 16:37
Location: Sudbury,Ontario
Contact:

### String Sorter, anyone have one?

Hey yall, does anyone have a way to sort strings in terms of alphabetical order, like in a dictionary?
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA
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 subdim as integer i,jdim 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) = tempnextfor i = 50 to 10000 step 200    print i, array(i)nextsleepprintQuickSortStr lbound(array), ubound(array), array()for i = 50 to 10000 step 200    print i, array(i)nextsleep`
Last edited by MichaelW on Oct 27, 2006 8:24, edited 1 time in total.
ytwinky
Posts: 217
Joined: Dec 03, 2005 12:44
Location: MD, Germany
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
Posts: 1710
Joined: Sep 11, 2005 7:08
Location: England
Contact:
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 QStackEnd Sub ' Quick testDim As String str_array(0 To 4)Dim As Integer istr_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
Posts: 1710
Joined: Sep 11, 2005 7:08
Location: England
Contact:
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 testDim As String str_array(0 To 4)Dim As Integer istr_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 `