New UserLib command: SortStructuredArrayFS()

[netmaestro]

I wrote this command to allow for the sorting of structured arrays on a fixed string field, which is currently not implemented natively. Included in the zip are Help, Library, Source and instructions for installation. I'm getting a bunch of libs scattered around, I'll probably round them all up and put them into one download, but not today. For now, here is the link:

http://www.networkmaestro.com/SortFS.zip

Any problems let me know. There's a usage example in the help file. Enjoy it!

[mskuma]

I'm getting a bunch of libs scattered around, I'll probably round them all up and put them into one download, but not today

Here's hoping one day soon you'll do that!! Because we all know it'll certainly be a thing of value & beauty.

[Kwai chang caine]

Link broken

2006...and not see that
Too late for try it and congratulation the master

Too early for RSBasic BACKUP site
http://www.rsbasic.de/backups/

Kcc ...always one delay train

[RSBasic]

Too early for RSBasic BACKUP site

Yes

[Kwai chang caine]

You have see ???
Now, my first reflex ...search in your royal site
Really an amazing idea you have, never the community can thank you enough

[blueb]

Directly from the 'Master's Bible'....

Code: Select all

;********************************************************* 
; Program:    SortStructuredArrayFS PureLibrary Command (Sort Fixed Strings in an Array)
; Author:     netmaestro 
; Date:       April 17, 2006
; Target OS:  Windows, probably works on Linux and Mac
; PB Version: 4.0 +
;********************************************************* 
; 
; Usage: SortStructuredArrayFS(first,last,@arrayayname(),Sizeof(structure),OffsetOf(structure\member),len)
;           

Procedure GE(*a,*b,l.l) ; Uppercase Greater or Equal
  Protected a,b,i
  bigger = #False
  smaller = #False
  For i=0 To l-1
    a=PeekB(*a+i):b=PeekB(*b+i)
    If a>=97 And a<=122
      a-32
    EndIf
    If b>=97 And b<=122
      b-32
    EndIf
    If a > b
      bigger=#True
      Break
    ElseIf a < b
      smaller=#True
      Break
    EndIf
  Next
  If Not smaller
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure LE(*a,*b,l.l) ; Uppercase Lessthan or equal
  Protected a,b,i
  bigger = #False
  smaller = #False
  For i=0 To l-1
    a=PeekB(*a+i):b=PeekB(*b+i)
    If a>=97 And a<=122
      a-32
    EndIf
    If b>=97 And b<=122
      b-32
    EndIf  
    If a > b
      bigger=#True
      Break
    ElseIf a < b
      smaller=#True
      Break
    EndIf
  Next
  If Not bigger
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf 
EndProcedure


ProcedureDLL SortStructuredarrayFS(first,last,thisarray,struc,member,len) ; Quicksort Algorithm 
  If Not *tmp 
    *tmp=AllocateMemory(struc) 
  EndIf 
  If first < last 
    i = first-1 
    j = last 
    Repeat 
      Repeat 
        i+1 
      Until GE(thisarray+i*struc+member, thisarray+last*struc+member ,len)
      Repeat 
        j-1
      Until LE(thisarray+j*struc+member, thisarray+last*struc+member ,len)
      CopyMemory(thisarray+i*struc,*tmp,struc) 
      CopyMemory(thisarray+j*struc,thisarray+i*struc,struc) 
      CopyMemory(*tmp,thisarray+j*struc,struc) 
    Until j <= i 
    CopyMemory(thisarray+j*struc,*tmp,struc) 
    CopyMemory(thisarray+i*struc,thisarray+j*struc,struc) 
    CopyMemory(thisarray+last*struc,thisarray+i*struc,struc) 
    CopyMemory(*tmp,thisarray+last*struc,struc) 
    SortStructuredarrayFS(first, i-1,thisarray,struc,member,len) 
    SortStructuredarrayFS(i+1, last,thisarray,struc,member,len) 
  EndIf 
EndProcedure 

;**********************************************************************
;  A test program for the SortStructuredArrayFS command
;********************************************************************** 
;
Structure member 
  age.l 
  name.s{5} 
  fav_color.s 
EndStructure 

Dim a.member(50000) 

For i=1 To 50000 ; Not responsible for any bad words that get made randomly! 
  a(i)\name=Chr(97+Random(25))+Chr(97+Random(25))+Chr(97+Random(25))+Chr(97+Random(25))+Chr(97+Random(25))
  a(i)\age = 21+Random(30) 
Next 

SortStructuredarrayFS(1,ArraySize(a()),@a(),SizeOf(member),OffsetOf(member\name),5) 

For i=1 To 50000 Step 1000                               
  Debug a(i)\name ;display every 1000th word
Next
End

[Kwai chang caine]

Thanks a lot god of bible

[wilbert]

This code is very old.
I assume CompareMemoryString wasn't available back then since it seems like a logical choice to do the compare.
You could also consider using qsort which is a cross platform api function.

[Kwai chang caine]

Hello WILBERT
In fact i want to sort a structured array, and the only code i have with QSort it's for a simple array

Code: Select all

ImportC "" 
 qsort(*base, num, size, *comparator)
EndImport 

Dim values.i(5)
values(0) = 40
values(1) = 10
values(2) = 100
values(3) = 90
values(4) = 20
values(5) = 25

ProcedureC.i Compare(*a.Integer, *b.Integer)
 ProcedureReturn *a\i - *b\i
EndProcedure

qsort(@values(), ArraySize(values()) + 1, SizeOf(Integer), @Compare())

For n = 0 To 5
  Debug values(n)
Next

[wilbert]

Here's a structured array example.
On most OS qsort is unstable meaning when a field you sort on is equal, it is possible the items get swapped.

Code: Select all

;-import qsort

ImportC "" 
 qsort(*base, num, size, *comparator)
EndImport 


;-create structured array

Structure Person
  id.l
  name.s
  city.s{20}
EndStructure

Dim Person.Person(3)

Person(0)\id = 105
Person(0)\name = "Charles"
Person(0)\city = "London"

Person(1)\id = 16
Person(1)\name = "Harry"
Person(1)\city = "London"

Person(2)\id = 32
Person(2)\name = "Matthew"
Person(2)\city = "New York"

Person(3)\id = 96
Person(3)\name = "Jacques"
Person(3)\city = "Paris"


;-compare procedures

ProcedureC.i CompareID(*a.Person, *b.Person)
  ProcedureReturn *a\id - *b\id
EndProcedure

ProcedureC.i CompareName(*a.Person, *b.Person)
  ProcedureReturn CompareMemoryString(@*a\name, @*b\name, #PB_String_NoCase)
EndProcedure

ProcedureC.i CompareCity(*a.Person, *b.Person)
  ProcedureReturn CompareMemoryString(@*a\city, @*b\city, #PB_String_NoCase)
EndProcedure

ProcedureC.i CompareCityFirstThenName(*a.Person, *b.Person)
  Protected.i cmp
  cmp = CompareMemoryString(@*a\city, @*b\city, #PB_String_NoCase)
  If cmp = 0
    cmp = CompareMemoryString(@*a\name, @*b\name, #PB_String_NoCase)
  EndIf
  ProcedureReturn cmp
EndProcedure


;-example

; Sort by name

qsort(@Person(), ArraySize(Person()) + 1, SizeOf(Person), @CompareName())

Debug ">> Sorted by name <<"
For i = 0 To 3
  With Person(i)
    Debug Str(\id) + " * " + \name + " * " + \city   
  EndWith
Next
Debug ""


; Sort by city

qsort(@Person(), ArraySize(Person()) + 1, SizeOf(Person), @CompareCity())

Debug ">> Sorted by city <<"
For i = 0 To 3
  With Person(i)
    Debug Str(\id) + " * " + \name + " * " + \city   
  EndWith
Next
Debug ""


; Sort by id

qsort(@Person(), ArraySize(Person()) + 1, SizeOf(Person), @CompareID())

Debug ">> Sorted by id <<"
For i = 0 To 3
  With Person(i)
    Debug Str(\id) + " * " + \name + " * " + \city   
  EndWith
Next
Debug ""


; Sort by city, name

qsort(@Person(), ArraySize(Person()) + 1, SizeOf(Person), @CompareCityFirstThenName())

Debug ">> Sorted by city, name <<"
For i = 0 To 3
  With Person(i)
    Debug Str(\id) + " * " + \name + " * " + \city   
  EndWith
Next
Debug ""

[Kwai chang caine]

Whaooouh !!! one thousand of thanks great MASTER WILBERT

Obviously, when i look the code, never i can found it alone
I use, and keep it, into my magic bag of miracle code

Really thanks, to have born a day, in this nice world
Really, unfortunately to have meet KCC, in the same bad world !!!

Have a very good day
Your fan....

[wilbert]

I made a small mistake with the example of sorting on two fields (forgot to rename something).
The updated code should work fine.
Have fun with it

[Kwai chang caine]

I'm already fun....again thanks

[wilbert]

Aaahhh. I made the same mistake as before
I thought my pointer compare made the procedure stable.
Skywalk pointed out this isn't the case
http://www.purebasic.fr/english/viewtop ... 43#p376743
Sorry ...

So if you need a stable sort, you have to use another sort algorithm.
Here's the same example as above with insertion sort which is slower but stable.

Code: Select all

;-isort

Prototype.i proto_cmp(*pointer, *pointer2)

Procedure isort(*base, num, size, *comparator.proto_cmp)
  Protected *p0, *p1 = *base + size, *p2 = *base + num * size
  Protected *mem = AllocateMemory(size, #PB_Memory_NoClear)
  While *p1 < *p2
    *p0 = *p1
    Repeat
      *p0 - size
      If *comparator(*p1, *p0) > 0
        *p0 + size
        Break
      EndIf
    Until *p0 = *base
    If *p1 > *p0
      CopyMemory(*p1, *mem, size)
      MoveMemory(*p0, *p0 + size, *p1 - *p0)
      CopyMemory(*mem, *p0, size)
    EndIf
    *p1 + size
  Wend
  FreeMemory(*mem)
EndProcedure


;-create structured array

Structure Person
  id.l
  name.s
  city.s{20}
EndStructure

Dim Person.Person(3)

Person(0)\id = 105
Person(0)\name = "Charles"
Person(0)\city = "London"

Person(1)\id = 16
Person(1)\name = "Harry"
Person(1)\city = "London"

Person(2)\id = 32
Person(2)\name = "Matthew"
Person(2)\city = "New York"

Person(3)\id = 96
Person(3)\name = "Jacques"
Person(3)\city = "Paris"


;-compare procedures

Procedure.i CompareID(*a.Person, *b.Person)
  ProcedureReturn *a\id - *b\id
EndProcedure

Procedure.i CompareName(*a.Person, *b.Person)
  ProcedureReturn CompareMemoryString(@*a\name, @*b\name, #PB_String_NoCase)
EndProcedure

Procedure.i CompareCity(*a.Person, *b.Person)
  ProcedureReturn CompareMemoryString(@*a\city, @*b\city, #PB_String_NoCase)
EndProcedure

Procedure.i CompareCityFirstThenName(*a.Person, *b.Person)
  Protected.i cmp
  cmp = CompareMemoryString(@*a\city, @*b\city, #PB_String_NoCase)
  If cmp = 0
    cmp = CompareMemoryString(@*a\name, @*b\name, #PB_String_NoCase)
  EndIf
  ProcedureReturn cmp
EndProcedure


;-example

; Sort by name

isort(@Person(), ArraySize(Person()) + 1, SizeOf(Person), @CompareName())

Debug ">> Sorted by name <<"
For i = 0 To 3
  With Person(i)
    Debug Str(\id) + " * " + \name + " * " + \city   
  EndWith
Next
Debug ""


; Sort by city

isort(@Person(), ArraySize(Person()) + 1, SizeOf(Person), @CompareCity())

Debug ">> Sorted by city <<"
For i = 0 To 3
  With Person(i)
    Debug Str(\id) + " * " + \name + " * " + \city   
  EndWith
Next
Debug ""


; Sort by id

isort(@Person(), ArraySize(Person()) + 1, SizeOf(Person), @CompareID())

Debug ">> Sorted by id <<"
For i = 0 To 3
  With Person(i)
    Debug Str(\id) + " * " + \name + " * " + \city   
  EndWith
Next
Debug ""


; Sort by city, name

isort(@Person(), ArraySize(Person()) + 1, SizeOf(Person), @CompareCityFirstThenName())

Debug ">> Sorted by city, name <<"
For i = 0 To 3
  With Person(i)
    Debug Str(\id) + " * " + \name + " * " + \city   
  EndWith
Next
Debug ""

[wilbert]

@netmaestro,
I see your SortStructuredArrayFS procedure also use quick sort.
Is your implementation a stable sort ?