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?

Postby axipher » Oct 26, 2006 2:51

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

Postby MichaelW » Oct 26, 2006 4:44

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
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

Postby ytwinky » Oct 26, 2006 12:01

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:

Postby yetifoot » Oct 26, 2006 17:03

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
Posts: 1710
Joined: Sep 11, 2005 7:08
Location: England
Contact:

Postby yetifoot » Oct 26, 2006 18:34

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

Return to “Beginners”

Who is online

Users browsing this forum: No registered users and 3 guests