PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

New UserLib command: SortStructuredArrayFS()

https://www.purebasic.fr/english/viewtopic.php?t=21245

Page 1 of 2

New UserLib command: SortStructuredArrayFS()

Posted: Tue Apr 18, 2006 8:15 am
by 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!

Re: New UserLib command: SortStructuredArrayFS()

Posted: Thu Aug 31, 2006 7:08 am
by mskuma
netmaestro wrote: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. :wink: :D

Re: New UserLib command: SortStructuredArrayFS()

Posted: Thu Oct 06, 2016 10:20 am
by Kwai chang caine
Link broken :cry:

2006...and not see that :shock: :?
Too late for try it and congratulation the master :oops:

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

Kcc ...always one delay train :oops:

Re: New UserLib command: SortStructuredArrayFS()

Posted: Thu Oct 06, 2016 10:26 am
by RSBasic
Kwai chang caine wrote:Too early :| for RSBasic BACKUP site 8)
Yes :cry:

Re: New UserLib command: SortStructuredArrayFS()

Posted: Thu Oct 06, 2016 11:38 am
by Kwai chang caine
You have see ???
Now, my first reflex ...search in your royal site :wink:
Really an amazing idea you have, never the community can thank you enough 8)

Re: New UserLib command: SortStructuredArrayFS()

Posted: Thu Oct 06, 2016 2:21 pm
by blueb
Directly from the 'Master's Bible'.... :mrgreen:

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

Re: New UserLib command: SortStructuredArrayFS()

Posted: Thu Oct 06, 2016 2:24 pm
by Kwai chang caine
Thanks a lot god of bible :lol: 8)

Re: New UserLib command: SortStructuredArrayFS()

Posted: Thu Oct 06, 2016 2:34 pm
by 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.

Re: New UserLib command: SortStructuredArrayFS()

Posted: Thu Oct 06, 2016 2:42 pm
by Kwai chang caine
Hello WILBERT :D
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

Re: New UserLib command: SortStructuredArrayFS()

Posted: Thu Oct 06, 2016 3:12 pm
by 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 ""

Re: New UserLib command: SortStructuredArrayFS()

Posted: Thu Oct 06, 2016 3:35 pm
by Kwai chang caine
Whaooouh !!! one thousand of thanks great MASTER WILBERT 8)

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

Really thanks, to have born a day, in this nice world 8) 8)
Really, unfortunately to have meet KCC, in the same bad world !!! :oops: :mrgreen:

Have a very good day
Your fan....

Re: New UserLib command: SortStructuredArrayFS()

Posted: Thu Oct 06, 2016 3:37 pm
by 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 :)

Re: New UserLib command: SortStructuredArrayFS()

Posted: Thu Oct 06, 2016 3:41 pm
by Kwai chang caine
I'm already fun....again thanks 8)

Re: New UserLib command: SortStructuredArrayFS()

Posted: Thu Oct 06, 2016 3:54 pm
by wilbert
Aaahhh. I made the same mistake as before :oops:
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 ""

Re: New UserLib command: SortStructuredArrayFS()

Posted: Thu Oct 06, 2016 4:04 pm
by wilbert
@netmaestro,
I see your SortStructuredArrayFS procedure also use quick sort.
Is your implementation a stable sort ?
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited