StringArray Sort (case independent)

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
Lost Zergling
Posts: 240
Joined: Dec 02, 2011 22:51
Location: France

Re: StringArray Sort (case independent)

Postby Lost Zergling » Aug 12, 2019 17:40

After accessing my computer again, .. My tests show that compared to the algorithm of Dodicat, Lzle is 8 to 9 times slower and especially that the need memory is much more important, in unacceptable proportions. I conclude that the list-based tool can not compete with an array in the proposed case, except to want additional features specific to the lists.
MrSwiss
Posts: 3220
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: StringArray Sort (case independent)

Postby MrSwiss » Aug 12, 2019 17:49

:lol: that is exactly, what I've been trying to tell you, all the time.

Remember: "more code, more trouble, less speed"
Lost Zergling
Posts: 240
Joined: Dec 02, 2011 22:51
Location: France

Re: StringArray Sort (case independent)

Postby Lost Zergling » Aug 12, 2019 18:48

@MrSwiss : you are right. It was nevertheless a real challenge. 2x slower could have been an issue, 8x slower definitely a pitfall. The tool still retains some interest, but this allows to better measure the limits. When the length of the strings exceeds a certain threshold and there is no implicit logical coherence, treating these strings as keys becomes too penalizing in terms of memory consumption without being able to benefit from a speed gain. This is not a victory as it reduces the scope of a tool that I have tried to make as flexible and easy as possible while maintaining decent performance. There are limits beyond which the use of the tool is no longer relevant, even considering the automated aspect. Estimate these limits remains the work of the developer but same time it brings less for attarctiveness.
dafhi
Posts: 1245
Joined: Jun 04, 2005 9:51

Re: StringArray Sort (case independent)

Postby dafhi » Aug 13, 2019 1:02

cool stuff dodicat. u know i love quicksort. u can static j in sortup()

pretend both J & I static

if j >begin ' destroyed I J not a concern, first explicit recursion
if i <finish ' destroyed I J a concern, but only 'i' and 'finish' used @ this line


[edit:] one might be able to do same w 'BEGIN.' i'll give it a try

[update] can do, but all I'm seeing is more LOC :D
Juergen Kuehlwein
Posts: 210
Joined: Mar 07, 2018 13:59
Location: Germany

Re: StringArray Sort (case independent)

Postby Juergen Kuehlwein » Aug 14, 2019 12:37

... back home again.

As promised i pushed my latest (still not yet finished) version. You will find all necessary information here (https://www.freebasic.net/forum/viewtopic.php?f=17&t=27606&p=263300#p263300)


JK
jj2007
Posts: 1215
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: StringArray Sort (case independent)

Postby jj2007 » Aug 15, 2019 0:12

For the fans of benchmarking sort algos, I put some test files here. The archive is 84MB and contains one exe plus source code using QSort(), plus three text files RandSheet*.tab with 10,000, 100k and 1M lines of random text.

The text files are in tab-delimited format and contain several columns. For testing the FB algos posted above, there shouldn't be any difference to single column files. I need the columns for testing my sort-by-column features. The third column contains numbers, again this is for testing QSort's numeric sorting function. To test the exe, drag one of the *.tab files over it. This is a typical output (Intel(R) Core(TM) i5-2450M CPU @ 2.50GHz):

Code: Select all

 -- QSortDesc: ----  vvv 1 vvv  ----------------------------------------------------
 0     [LSJsMFExpWD [ZzZYpUYBzEf [88878]      [tCJvDefeCF] [UZSQczcPU]  [wPdcYSkjAAi
 1     [yTuogQSMJLQ [ZZZyPcilSYZ [-340034487] [CPmdMrCGDGs [RWOQMhmvE9d [OXkHRuDYRwv
 2     [BzmBIicRmu] [ZzZyKlQMCv0 [0903770409] [bBXumuyyKV] [tmDoLKKlzH] [yYdVGpvTO.3
 3     [HLitVSSWKaV [ZzZYFyqJagP [17274]      [VVdSZmhMwmh [KcvWCBqXAj8 [txMkERs]
 4     [fZxdtTFHbTO [ZZZxqTumwbI [07991925]   [FfWHAgTMKJJ [OOtbVkkkY93 [smXdj]
 5     [xoGIcUXxCK4 [zzZXmVcTz 8 [136019]     [IzQDeKamTxp []           []
 6     [YPSzBxPIvAZ [ZzzXAGhav?1 [5532080252] [GmIrIBSXQQj [zHsPwMFhvsU [IYZqAPXKBP]
 7     [rSaErQFhXcI [ZZzwUApXm K [914714]     [yPKZYSQbq]  [AqhiWkMvIK9 []
 8     [MvuHKHmBEjf [zzZWtCmvCMi [9370382660] [wZhpFILBbJV [LkFPQxMrX]  [eHzLjgk]
 9     [KdHmLxLwCDs [zzzWMmAzXHH [-408528867] [VVtooqYIDT? []           []
 2136 ms for sorting 1000000 lines in column 1 - hit left, right or Escape

 -- QSortAsc: -----  vvv 1 vvv  ----------------------------------------------------
 0     [zGrSOMmVExm [A]          []           []           []           []
 1     [wvjamocqwtt [A]          []           []           []           []
 2     [TACLQlmGSLm [A]          []           []           []           []
 3     [ZfZGMJpJYj0 [A]          []           []           []           []
 4     [TMvLqSFWmBb [AaAAaxSXI0Z [74602]      [lZuUAuMCv33 [AYvYwKmaPR6 [O]
 5     [ojHHKuOeQxu [AaaapLXrdWA [2078439324] [kGjISwmmld? [XBdEhLR]    []
 6     [rMrcgTMXMMM [aaABHjflm5M [2123380543] [WQqUzuGsGIc []           []
 7     [EYyjJSKzcOu [AAabyCIkK]  [365129]     [IvhdAqYmQV] [qiXLamvwhiJ [MwBGlDAmvu7
 8     [OGkPfrdrXgw [aAaCtgJcrm3 [78797906]   [RIsEhbxDy8R [gGqtPSfcakb [HDwQuIAVhko
 9     [drDgmzOmmSK [aAADOhcoRmy [1324749566] [dAueeQVsP25 []           []
 978 ms for sorting 1000000 lines in column 1 - hit left, right or Escapee
Juergen Kuehlwein
Posts: 210
Joined: Mar 07, 2018 13:59
Location: Germany

Re: StringArray Sort (case independent)

Postby Juergen Kuehlwein » Aug 15, 2019 10:46

This is what i get dropping RandSheet.tab

811 bytes for MbQSortP2
Testing MbQSortP2 with D:\Users\Administrator\Desktop\test\jj2007\RandSheet.tab (built with UAsm64)
Recall qsMaxCol 8







-- QSortDesc: ---- vvv 1 vvv ----------------------------------------------------------------------------------------
0---- [LSJsMFExpWD [ZzZYpUYBzEf [88878] [tCJvDefeCF] [UZSQczcPU] [wPdcYSkjAAi [UVqKSKjmKf7 [WdwGkYQAM3h6q]
[WSmmVxs]

1 [yTuogQSMJLQ [ZZZyPcilSYZ [-340034487] [CPmdMrCGDGs [RWOQMhmvE9d [OXkHRuDYRwv [] [] []

2 [BzmBIicRmu] [ZzZyKlQMCv0 [0903770409] [bBXumuyyKV] [tmDoLKKlzH] [yYdVGpvTO.3 [] [] []

3 [HLitVSSWKaV [ZzZYFyqJagP [17274] [VVdSZmhMwmh [KcvWCBqXAj8 [txMkERs] [] [] []

4 [fZxdtTFHbTO [ZZZxqTumwbI [07991925] [FfWHAgTMKJJ [OOtbVkkkY93 [smXdj] [] [] []

5 [xoGIcUXxCK4 [zzZXmVcTz 8 [136019] [IzQDeKamTxp [] [] [] [] []

0 [zGrSOMmVExm [A] [] [] [] [] [] [] []

1 [wvjamocqwtt [A] [] [] [] [] [] [] []

2 [TACLQlmGSLm [A] [] [] [] [] [] [] []

3 [ZfZGMJpJYj0 [A] [] [] [] [] [] [] []

4218 [TMvLqSFWmBb [AaAAaxSXI0Z [74602] [lZuUAuMCv33 [AYvYwKmaPR6 [O] [] [] []

5- QS [ojHHKuOeQxu [AaaapLXrdWA [2078439324] [kGjISwmmld? [XBdEhLR] [] [] [] []
vvv 1 vvv
6 [rMrcgTMXMMM [aaABHjflm5M [2123380543] [WQqUzuGsGIc [] [] [] [] []

7 [EYyjJSKzcOu [AAabyCIkK] [365129] [IvhdAqYmQV] [qiXLamvwhiJ [MwBGlDAmvu7 [kMhRlrp] [] []

8 [OGkPfrdrXgw [aAaCtgJcrm3 [78797906] [RIsEhbxDy8R [gGqtPSfcakb [HDwQuIAVhko [] [] []

9 [drDgmzOmmSK [aAADOhcoRmy [1324749566] [dAueeQVsP25 [] [] [] [] []

746 ms for sorting 1000000 lines in column 1 - hit left, right or Escape



Running this code with the data (1000000 lines) from RandSheet.tab

Code: Select all

#compiler freebasic
#compile console 32

#include "ustring.bi"
#include "array.bi"


'Sub show(L() As ZString)
Sub show(L() As String)
    For n As Long=Lbound(L) To 10
        Print left(L(n), 50) & "..."
'        Print L(n)
    Next
    For n As Long=1 To 4
        Print "..."
    Next
    For n As Long=Ubound(L)-10 To Ubound(L)
        Print left(L(n), 50) & "..."
'        Print L(n)
    Next
End Sub


'sub load(l() as zstring)
sub load(l() as string)
'***********************************************************************************************
'
'***********************************************************************************************
dim i as long
dim x as long
dim y as long
dim z as long
dim txt as string


  open "D:\Users\Administrator\Desktop\test\jj2007\randsheet.tab" for binary as #1
    txt = String(LOF(1), 0)
    Get #1, ,txt
  close #1


  i = 1
  x = 1
  y = instr(txt, chr(13)+chr(10))

  while y > 0
    l(i) = mid(txt, x, y-x)
    x = y + 2
    i = i + 1

    if i > 1000000 then exit while

    y = instr(x, txt, chr(13)+chr(10))
  wend 
   
   
end sub


'***********************************************************************************************



Dim As Double t1,t2
Dim As Long limit=1000000
'Dim As zString * 260 L(1 To limit)
Dim As String L(1 To limit)

Print "Loading string"

load(l())

Print "sort"
t1=Timer

array(sort, (l, nocase))             
'array(sort, l)

t2=Timer
show(L())
Print t2-t1;"  Seconds"

Sleep
end



i get this:


Loading string
sort
aAAaDRlxDhjtBayt92Hh27 teqTbVMMIIp bJcWcCauD7hsF8Q...
aAAbHqwmbilCzSxlUB rwqSbdXuACt3?mgjo8lz8 I?3oBf 98...
AaaBKFFHYtLZ3KzT1xPR tFfjcOPlsPLeIP 8169794940 yoP...
AAAblQQVmKx vd0i50U7R ulHSrgKAQOaTf 9632857 PmMlu...
aaaBxAOKhpg4QmHLb s kFGlPBjzP5i -402285686 skrIfDH...
AAacDtWYeEprPKmCx3zMxm?vufHipRVYpMkUXmPV6.vHwfTvg7...
AAadcEJmahg IVKgYefsU 36528 eMQfBkrtj1gbGt G6 PhOx...
AaadGYxxySujXyDAiMYOBQ2muQ7mHub1 PsgwhKlZxp2HYMJ5x...
AaADvqMvFACemJazOhWSOBoAcdRHZw UexpGFAbEbf -976268...
aaAeSgHZPmIRm0P?yD ylxPFWjEftLFwoo XH1CeSJTk1JWd 0...
...
...
...
...
zzzTCKGVQhR3fwfS1F IafIAlORd6G5Zh 8734662078 xSPlr...
ZzzuexumpdCcmX0gim MdMMvaJadYW 0237956340 XsYsRbsa...
ZzZvbsOkcwYBa tcMFQYbUZi4m8CH6qqo.l 3129129335 Wiu...
zzZvDhCdZm gJYtJzGeIM8L 0073082 wwPafPMftcaQ PlcAk...
ZzZVoLWmHX2aFRcY IGWDweoJT7EHPLM2m 17229 kVecmFsPj...
ZZZVYBOZhImb.lzPzdyStLs3Hjc1s9vHY3mPeEGAx2LbX.vR2T...
ZZZWDgKyse1KhTF1gsu80lC7qHMpKUoJQ3 oplKiLzxftQDbou...
zZzxbxsYBAMIMtlmmlddo?mgVTLqbq11jTz oTIPpJcLPFafVA...
zzzXQPIUwtjhkrMeB9gWZCMUPDU su0UlBZ11i4VZabSRuOss...
zzzycupKuihf4ieUqpROvPlM1huMwuFLC bMoFRGjVC -24449...
zZZyZMiIbwLF7j peM QPoKDGRkyOXRAr DcyvID57.WpMyfyp...
0.6362393114141014 Seconds



JK
jj2007
Posts: 1215
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: StringArray Sort (case independent)

Postby jj2007 » Aug 15, 2019 12:38

0.636 seconds is impressive, compliments!

To see my results properly, it is maybe necessary to enlarge the console window; and they should be in code tags, too. In any case, I can't get near your time. The first run is around 1.8 seconds, the second one 0.8 - and that one is biased because the array is already sorted the other way round. So it seems QuickSort wins over MergeSort in terms of speed. The advantage of MergeSort, though: it's a stable sort. Not relevant in this specific case, but if you want to sort a spreadsheet first by name, then by City, you might want to keep the "name" order for the cities found.
dodicat
Posts: 5913
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: StringArray Sort (case independent)

Postby dodicat » Aug 15, 2019 12:57

jj2007
Your .exe went into quarantine on the first drop.
Sorry.
But I grabbed the million line file.
Here is my quicksort.

Code: Select all

 

#include "file.bi"

Dim Shared As Ubyte u(255)
#define lwr(s) iif(s<91 andalso s>64,s+32,s)
For n As Long=0 To 255
    u(n)=lwr(n)  'lookup
Next

Function lessthan(a As String,b As String,Lenb As Long)   As Long
    Static As Long lena
    lena=Cast(Integer Ptr,@a)[1]'=Len(a)
    For n As Long =0 To Iif(lena<lenb,lena,lenb)-1
        If u(a[n]) < u(b[n]) Then  Return -1
        If u(a[n]) > u(b[n]) Then  Return 0
    Next
    Return 0
End Function

Function morethan(a As String,b As String,lenb As Long)  As Long
    Static As Long lena
    lena=Cast(Integer Ptr,@a)[1]'=Len(a)
    For n As Long  =0 To Iif(lena<lenb,lena,lenb)-1
        If u(a[n]) > u(b[n]) Then Return -1
        If u(a[n]) < u(b[n]) Then Return 0
    Next
    Return 0
End Function

Sub sortup(array() As String,begin As Long,Finish As Long)
    Static As String x
    Var i=begin,j=finish
    x=(array(((I+J)\2)))
     Var lenx=Cast(Integer Ptr,@x)[1]'=len(X)  'get length here instead of in the loops
    While I <= J
        While lessthan(array(I),X,lenx):I+=1:Wend
        While morethan(array(J),X,lenx):J-=1:Wend
        If I<=J Then Swap array(I),array(J): I+=1:J-=1
    Wend
            If J >begin Then  sortup(array(),begin,J)
            If I <Finish Then sortup(array(),I,Finish)
        End Sub
       
Sub sortdown(array() As String,begin As Long,Finish As Long)
    Static As String x
    Var i=begin,j=finish
    x=(array(((I+J)\2)))
    Var lenx=Cast(Integer Ptr,@x)[1]'=len(X)
    While I <= J
        While morethan(array(I),X,lenx):I+=1:Wend
        While lessthan(array(J),X,lenx):J-=1:Wend
            If I<=J Then Swap array(I),array(J): I+=1:J-=1
    Wend
            If J >begin Then  sortdown(array(),begin,J)
            If I <Finish Then sortdown(array(),I,Finish)
        End Sub
       
Function String_Split(s_in As String,chars As String,result() As String) As Long
    Dim As Long ctr,ctr2,k,n,LC=Len(chars)
    Dim As boolean tally(Len(s_in))
    #macro check_instring()
    n=0
    While n<Lc
        If chars[n]=s_in[k] Then
            tally(k)=true
            If (ctr2-1) Then ctr+=1
            ctr2=0
            Exit While
        End If
        n+=1
    Wend
    #endmacro
   
    #macro split()
    If tally(k) Then
        If (ctr2-1) Then ctr+=1:result(ctr)=Mid(s_in,k+2-ctr2,ctr2-1)
        ctr2=0
    End If
    #endmacro
    '==================  LOOP TWICE =======================
    For k  =0 To Len(s_in)-1
        ctr2+=1:check_instring()
    Next k
     If ctr=0 Then
         If Len(s_in) Andalso Instr(chars,Chr(s_in[0])) Then ctr=1':beep
         End If
    If ctr Then Redim result(1 To ctr): ctr=0:ctr2=0 Else  Return 0
    For k  =0 To Len(s_in)-1
        ctr2+=1:split()
    Next k
    '===================== Last one ========================
    If ctr2>0 Then
        Redim Preserve result(1 To ctr+1)
        result(ctr+1)=Mid(s_in,k+1-ctr2,ctr2)
    End If
   
    Return Ubound(result)
End Function

Function loadfile Overload(file As String) As String
    If Fileexists(file)=0 Then Print file;" not loaded":Sleep
    Var  f=Freefile
    Open file For Binary Access Read As #f
    Dim As String text
    If Lof(f) > 0 Then
        text = String(Lof(f), 0)
        Get #f, , text
    End If
    Close #f
    Return text
End Function

function loadfile(file As String,s() As String,delim as string=chr(13,10)) as long
return string_split(loadfile(file),delim,s())
End function

Sub show(L() As String)
    For n As Long=Lbound(L) To 10
         Print left(L(n), 50) & "  ..."
        'Print L(n)
    Next
    For n As Long=1 To 4
        Print "..."
    Next
    For n As Long=Ubound(L)-10 To Ubound(L)
         Print left(L(n), 50) & "  ..."
       ' Print L(n)
    Next
End Sub

Redim As String s()
print cbool(loadfile("Randsheet.tab",s()))

Dim As Double t=Timer,t2
sortup(s(),Lbound(s),Ubound(s))
t2=Timer-t

show(s())
Print
Print "time taken ";t2
Print "number of lines sorted  ";Ubound(s)-Lbound(s)+1

print "done"
sleep

   
 
     

and the result

Code: Select all

  true
aAAaDRlxDhjtBayt92Hh27 teqTbVMMIIp      bJcWcCauD7hsF8Q  ...
aAAbHqwmbilCzSxlUB      rwqSbdXuACt3?mgjo8lz8 I?3oBf    98  ...
AaaBKFFHYtLZ3KzT1xPR    tFfjcOPlsPLeIP  8169794940      yoP  ...
AAAblQQVmKx  vd0i50U7R  ulHSrgKAQOaTf   9632857 PmMlu  ...
aaaBxAOKhpg4QmHLb s     kFGlPBjzP5i     -402285686      skrIfDH  ...
AAacDtWYeEprPKmCx3zMxm?vufHipRVYpMkUXmPV6.vHwfTvg7  ...
AAadcEJmahg     IVKgYefsU       36528   eMQfBkrtj1gbGt G6       PhOx  ...
AaadGYxxySujXyDAiMYOBQ2muQ7mHub1        PsgwhKlZxp2HYMJ5x  ...
AaADvqMvFACemJazOhWSOBoAcdRHZw  UexpGFAbEbf     -976268  ...
aaAeSgHZPmIRm0P?yD      ylxPFWjEftLFwoo XH1CeSJTk1JWd   0  ...
...
...
...
...
zzzTCKGVQhR3fwfS1F      IafIAlORd6G5Zh  8734662078      xSPlr  ...
ZzzuexumpdCcmX0gim      MdMMvaJadYW     0237956340      XsYsRbsa  ...
ZzZvbsOkcwYBa   tcMFQYbUZi4m8CH6qqo.l   3129129335      Wiu  ...
zzZvDhCdZm      gJYtJzGeIM8L    0073082 wwPafPMftcaQ    PlcAk  ...
ZzZVoLWmHX2aFRcY        IGWDweoJT7EHPLM2m       17229   kVecmFsPj  ...
ZZZVYBOZhImb.lzPzdyStLs3Hjc1s9vHY3mPeEGAx2LbX.vR2T  ...
ZZZWDgKyse1KhTF1gsu80lC7qHMpKUoJQ3      oplKiLzxftQDbou  ...
zZzxbxsYBAMIMtlmmlddo?mgVTLqbq11jTz     oTIPpJcLPFafVA  ...
zzzXQPIUwtjhkrMeB9gWZCMUPDU  su0UlBZ11i4VZabSRuOss  ...
zzzycupKuihf4ieUqpROvPlM1huMwuFLC       bMoFRGjVC       -24449  ...
zZZyZMiIbwLF7j peM      QPoKDGRkyOXRAr DcyvID57.WpMyfyp  ...

time taken  0.9085521000015433
number of lines sorted   1000000
done
 
Juergen Kuehlwein
Posts: 210
Joined: Mar 07, 2018 13:59
Location: Germany

Re: StringArray Sort (case independent)

Postby Juergen Kuehlwein » Aug 15, 2019 13:20

What i find remarkable is, that C code wins over Assembler code!

Whenever there was need for speed, i coded a function as a special Assembler version and most of times the speed gain was impressive (~ 30 timer faster). I´m impressed by the work of the the C compiler.


JK
jj2007
Posts: 1215
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: StringArray Sort (case independent)

Postby jj2007 » Aug 15, 2019 13:44

Juergen, it's difficult to compare them. As explained above, QSort() is a stable mergesort, not a quicksort (despite of the name). But I agree that C compilers have improved a lot, sometimes there is no difference at all between C and assembly. Still, we normally beat the CRT ;-)
dodicat wrote:jj2007
Your .exe went into quarantine on the first drop.
Yep, the AV brigade don't like executables that don't look "normal" ;-)
dodicat
Posts: 5913
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: StringArray Sort (case independent)

Postby dodicat » Aug 16, 2019 12:09

I found a pointer method for quicksort and adapted it accordingly.
Now less than .8 seconds for a million.
Only sortup is used here.
Strangely I cannot get a quicksort macro method up to speed, thinking that macro calls will inline everything rather than function calls.
I don't suppose I'll get to .6 seconds with pure fb code.
I have downloaded jK's work and I am trying the binaries, but unfortunately I am encountering snags (cannot find .bi files)
Anyway here is the pointer method (which I dislike).

Code: Select all

 

Dim Shared As string * 255 u
For n As Long=0 To 255
    u[n]=iif(n<91 andalso n>64,n+32,n)  'lookup string
Next

Function less(a As String ptr,b As String ptr,Lenb As Long)   As Long
    var lena=Cast(Integer Ptr,a)[1]'=Len(*a)
    For n As Long =0 To Iif(lena<lenb,lena,lenb)-1
        If u[(a)[0][n]] < u[(b)[0][n]] Then  Return -1
        If u[(a)[0][n]] > u[(b)[0][n]] Then  Return 0
    Next
    Return 0
End Function

sub quicksort(low as string ptr,high as string ptr)
  if (high-low <= 1) then return
  var J=low+1,I=J,lenl=Cast(Integer Ptr,low)[1]'=len(*low)
  while J <= high
  if less(J,low,lenl) then swap *J,*I:I+=1
  J+=1
  wend
  J=I-1:swap *low,*J
  quicksort(low,J)
  quicksort(I,high)
end sub

  Sub create(L() As String)
    #define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
    #define q range(97,122)-Iif(Rnd>.5,32,0)
    Randomize 1
    For n As Long=Lbound(L) To Ubound(L)
        Dim As String g1=Chr(q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q)
        Dim As String g2=Chr(q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q)
        Dim As String g3=Chr(q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q)
        L(n)=Left(g1+g2+g3,60+Rnd*30)
    Next
End Sub

Sub show(L() As String)
    For n As Long=Lbound(L) To 10
        Print L(n)
    Next
    For n As Long=1 To 4
        Print "..."
    Next
    For n As Long=Ubound(L)-10 To Ubound(L)
        Print L(n)
    Next
End Sub

Dim As Double t1,t2
Dim As Long limit=1000000
Dim As String L(1 To limit)
Print "Creating string"
create(L())
Print "Commence sort (crt)"
t1=Timer
quicksort(@L(Lbound(L)),@L(Ubound(L)))
t2=Timer
show(L())
Print t2-t1;"  Seconds quicksort"
Sleep

 


...
...
ZZzyzetRGgWITClgQOTutTCdCiuHMxPNPuxGIsUFqStMIuIRPqlWpHdzyckcajQMCgNTbYzilNuy
zzZzcsrZGTHbiajufJIMXwWdbKFncznEBmlSLCGJBKFTHoixDzzNgeXSRohyfJHAQreI
zZZzToOoFStspcNrVaEIfjsxTNFZWUIwVWqxrzppJBjnxhbFgXmoCjUQxitzjpsLsmkTJefTDsKUKDj
0.7890132000029553 Seconds quicksort

(win 10 64 bits -Wc -O3)
jj2007
Posts: 1215
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: StringArray Sort (case independent)

Postby jj2007 » Aug 16, 2019 14:55

dodicat wrote:I found a pointer method for quicksort and adapted it accordingly.
Now less than .8 seconds for a million.
For case-insensitive strings, that is pretty fast indeed!

dodicat wrote:I have downloaded jK's work and I am trying the binaries, but unfortunately I am encountering snags (cannot find .bi files)
Same problem here, some files are missing.

I found a nice comparison here: https://attractivechaos.wordpress.com/2 ... lgorithms/

As mentioned earlier, QSort() is a stable merge sort, and it's a variant that does not need additional memory.
Juergen Kuehlwein
Posts: 210
Joined: Mar 07, 2018 13:59
Location: Germany

Re: StringArray Sort (case independent)

Postby Juergen Kuehlwein » Aug 16, 2019 16:37

After exchanging the executables and libraries (fbc.exe, fbrt0.o, libfb.a and libfbmt.a, 32 and/or 64 bit !) you need "array.bi" and "ustring.bi" from the same directory ("new"), then it should work. At least for me it does (i use a batch file for copying back and forth). Or you play with the code in /new, e.g. "dodicat_sort.bas"

If it still doesn´t work, please tell me exactly what the compiler complains about. That is, post the error message(s) or the whole compiler listing.

JK
dodicat
Posts: 5913
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: StringArray Sort (case independent)

Postby dodicat » Aug 17, 2019 10:31

JK
Working directly within the new folder and using the executable Fbc_64.exe
The command is
Fbc_64.exe dodicat_sort.bas.
The errors:
dodicat_sort.bas(1) error 17: Syntax error, found 'compiler' in '#compiler freebasic'

. . . fbc-array\fbc-array\new\ustring.bi(16) error 23: File not found, "crt\mem.bi" in '#include once "crt\mem.bi"'

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 21 guests