Sort Array

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Sort Array

Post by dodicat »

Here is combsort again (slightly slower than quicksort) but more general:

Code: Select all

 
 

 #macro combsort(array,begin,finish,dot,direction)
    Scope
        Var size=(finish),switch=0,j=0
        Dim As Single void=size
        Do
            void=void/1.3: If void<1 Then void=1
            switch=0
            For i As Integer =(begin) To size-void
                j=i+void
                If array(i)dot direction array(j)dot Then 
                    Swap array(i),array(j): switch=1
                End If
            Next
        Loop Until  switch =0 And void=1
    End Scope
    #endmacro
    
    #macro printout(X)
    ?
    print " Variable: ";
    print #X
    ?
    for n as integer=lbound(X) to lbound(X)+10
        print x(n)
    next n
    ?:?
    print "..."
    ?:?
    for n as integer=ubound(X)-10 to ubound(X) 
        print x(n)
    next n
    print "_________________________"
    ?
    #endmacro
    
    type mytype
        as integer i
        as string s
        declare operator cast() as string
    end type
    
    union myunion
        as single s(1 to 2)
        declare operator cast() as string
    end union
    
    operator mytype.cast as string
    var pad=30-len(str(i))
    var fill=string(pad," ")
    return str(i)+fill+s
    end operator
    
    operator myunion.cast as string
    var pad=30-len(str(s(1)))
    var fill=string(pad," ")
    return str(s(1))+fill+str(s(2))
    end operator
    
    dim as integer size =250000
    
    dim shared as double d(1 to size)
    dim shared as string s(1 to size)
    dim shared as mytype mt(1 to size)
    dim shared as myunion mu(1 to size)
    
    for n as integer=1 to size
        d(n)=rnd*5-rnd*5
        s(n)=str(3+rnd*10)
        mt(n).i=rnd*500
        mt(n).s=str(n)
        mu(n).s(1)=rnd*100
        mu(n).s(2)=rnd*1000
        next n
print "values set"
dim as double t=timer
combsort(d,lbound(d),ubound(d),,<):print "double sorted"
combsort(s,lbound(s),ubound(s),,<):print "string sorted"
combsort(mt,lbound(mt),ubound(mt),.s,<):print "type mytype sorted, string part"
combsort(mu,lbound(mu),ubound(mu),.s(2),<):print "union myunion sorted, second field"
print
print "Time for four sorts of ";size;" = ";timer-t
print
printout(d)
printout(s)
printout(mt)
printout(mu)
print "done"
sleep


   
 
    
Aethelstan
Posts: 19
Joined: Feb 22, 2017 18:34

Re: Sort Array

Post by Aethelstan »

It's an old thread, but maybe it's worth refreshing.
I was trying to improve Zippy's string sort and ended up with this. I changed 2 things: replaced standard string comparisons with strcmp function and included simple hash table, so I could eliminate most of string comparisons with their faster, integer counterparts. With big tables there should be a significant increase in speed; with small ones it may work actually slower (creating and managing hash table takes some additional time). Still, someone might find it usefull (after thorough testing, of course :) ) Most important changes in code are marked with [*].

Code: Select all

'sort string array
' fb-updated conversion of Ethan Winer's Quick Sort, ca 1992
'
declare sub Qsort overload (myStrArray() as string, Hash() As ULong, startEl as integer,numEls as integer,sortdir as integer =1)
#Include "crt\string.bi"	'for strcmp function
'
dim as integer i=5000000
dim as string myStrArray(i-1)
Dim As ULong Hash(i-1)
Dim As String t
dim as integer c
dim as double bt,et
'
'randomize timer
print "Building array..."
for c = 0 to i-1
    myStrArray(c)=str((int(rnd * i)))
Next
'
print "Building hash table..."
Sleep 1
bt=Timer
For c= 0 To i-1
	'in case string is too short, add some zeros at the end of it
	If Len(myStrArray(c))<4 Then 
		t=myStrArray(c)+Chr(0,0,0,0)
		Hash(c)=(((((t[0] Shl 8) Or t[1]) Shl 8) Or t[2]) Shl 8) Or t[3]
	Else 
		Hash(c)=(((((myStrArray(c)[0] Shl 8) Or myStrArray(c)[1]) Shl 8) Or myStrArray(c)[2]) Shl 8) Or myStrArray(c)[3]
	EndIf
Next
et=Timer
print using "Elapsed         : ###.######## seconds";et-bt

print
print "String sort, descending, started (this is MUCH slower than integer sort)"
'bt=timer
Qsort(myStrArray(),Hash(),0,i,1)
et=timer
print using "Elapsed total   : ###.######## seconds";et-bt
print "Elements sorted :";ubound(myStrArray)-lbound(myStrArray)+1
print "Sorts per second:";int((1/(et-bt))*(ubound(myStrArray)-lbound(myStrArray)+1))
print
'
for c= 0 to 8
    print "Index: ";c;tab(20);"StrValue: ";myStrArray(c), Hash(c)
next
'
for c=i-1 to i-8 step -1
    print "Index: ";c;tab(20);"StrValue: ";myStrArray(c), Hash(c)
next
'
print
print "Done, Sleeping to Exit.."
sleep
'end
'
sub Qsort(myStrArray() as string, Hash() As ULong, startEl as integer,numEls as integer,sortdir as integer =1)
'
    dim as integer qstack(NumEls\5+10)
    dim as integer i,j,first,last,curr,stackptr
    dim as String temp
    Dim As ULong htemp
    '
    first = startEl
    last  = StartEl + NumEls - 1
    
    do
        Do
        		curr=(last+first) Shr 1
            temp=myStrArray(curr)
            htemp=Hash(curr)
            i=first:j=last
            Do
            	'you can change strcmp line with it's <> counterpart to see the difference 
                if sortdir=1 then 'ascending
                		While Hash(i)<htemp:i+=1:Wend	'[*] instead of comparing strings, compare integers 
'                  	while myStrArray(i)<temp:i+=1:Wend
							While strcmp(myStrArray(i),temp)=-1:i+=1:Wend
                  	While Hash(j)>htemp:j-=1:Wend	'[*]
'                  	while myStrArray(j)>temp:j-=1:wend
							While strcmp(myStrArray(j),temp)=1:j-=1:Wend
                else              'decending
                		While Hash(i)>htemp:i+=1:Wend	'[*]
'                  	while myStrArray(i)>temp:i+=1:Wend
							While strcmp(myStrArray(i),temp)=1:i+=1:Wend
                  	While Hash(j)<htemp:j-=1:Wend	'[*]
'                  	while myStrArray(j)<temp:j-=1:wend
							While strcmp(myStrArray(j),temp)=-1:j-=1:Wend     
                end if   
                if i>j then exit do
                if i<j then swap myStrArray(i),myStrArray(j): Swap Hash(i),Hash(j)	'[*] swap also hashtable  
                i+=1:j-=1
            loop until i > j
            if i < last then
                qstack(stackptr)=i
                qstack(stackptr+1)=last
                stackptr+=2
            end if
            last=j
        loop until first>=last
        if stackptr=0 then
            exit do
        end if
        stackptr-=2
        first=qstack(stackptr)
        last=qstack(stackptr+1)
    loop
'
end sub
sean_vn
Posts: 283
Joined: Aug 06, 2012 8:26

Re: Sort Array

Post by sean_vn »

it's mentioned here that that you can speed quicksort by using subrandom numbers: https://en.wikipedia.org/wiki/Low-discrepancy_sequence
I guess you use subrandom sampling to pick a nice splitting value for the quicksort.
Post Reply