New UserLib command: SortStructuredArrayFS()
- netmaestro
- PureBasic Bullfrog
- Posts: 8433
- Joined: Wed Jul 06, 2005 5:42 am
- Location: Fort Nelson, BC, Canada
New UserLib command: SortStructuredArrayFS()
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!
http://www.networkmaestro.com/SortFS.zip
Any problems let me know. There's a usage example in the help file. Enjoy it!
BERESHEIT
Re: New UserLib command: SortStructuredArrayFS()
Here's hoping one day soon you'll do that!! Because we all know it'll certainly be a thing of value & beauty.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
- Kwai chang caine
- Always Here
- Posts: 5357
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Re: New UserLib command: SortStructuredArrayFS()
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
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
The happiness is a road...
Not a destination
Not a destination
- RSBasic
- Moderator
- Posts: 1218
- Joined: Thu Dec 31, 2009 11:05 pm
- Location: Gernsbach (Germany)
- Contact:
Re: New UserLib command: SortStructuredArrayFS()
YesKwai chang caine wrote:Too early for RSBasic BACKUP site
- Kwai chang caine
- Always Here
- Posts: 5357
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Re: New UserLib command: SortStructuredArrayFS()
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
Now, my first reflex ...search in your royal site
Really an amazing idea you have, never the community can thank you enough
The happiness is a road...
Not a destination
Not a destination
Re: New UserLib command: SortStructuredArrayFS()
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
- It was too lonely at the top.
System : PB 6.10 LTS (x64) and Win Pro 11 (x64)
Hardware: AMD Ryzen 9 5900X w/64 gigs Ram, AMD RX 6950 XT Graphics w/16gigs Mem
System : PB 6.10 LTS (x64) and Win Pro 11 (x64)
Hardware: AMD Ryzen 9 5900X w/64 gigs Ram, AMD RX 6950 XT Graphics w/16gigs Mem
- Kwai chang caine
- Always Here
- Posts: 5357
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Re: New UserLib command: SortStructuredArrayFS()
Thanks a lot god of bible
The happiness is a road...
Not a destination
Not a destination
Re: New UserLib command: SortStructuredArrayFS()
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.
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.
Windows (x64)
Raspberry Pi OS (Arm64)
Raspberry Pi OS (Arm64)
- Kwai chang caine
- Always Here
- Posts: 5357
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Re: New UserLib command: SortStructuredArrayFS()
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
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
The happiness is a road...
Not a destination
Not a destination
Re: New UserLib command: SortStructuredArrayFS()
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.
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 ""
Last edited by wilbert on Thu Oct 06, 2016 3:57 pm, edited 2 times in total.
Windows (x64)
Raspberry Pi OS (Arm64)
Raspberry Pi OS (Arm64)
- Kwai chang caine
- Always Here
- Posts: 5357
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Re: New UserLib command: SortStructuredArrayFS()
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....
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....
The happiness is a road...
Not a destination
Not a destination
Re: New UserLib command: SortStructuredArrayFS()
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
The updated code should work fine.
Have fun with it
Windows (x64)
Raspberry Pi OS (Arm64)
Raspberry Pi OS (Arm64)
- Kwai chang caine
- Always Here
- Posts: 5357
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Re: New UserLib command: SortStructuredArrayFS()
I'm already fun....again thanks
The happiness is a road...
Not a destination
Not a destination
Re: New UserLib command: SortStructuredArrayFS()
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.
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 ""
Windows (x64)
Raspberry Pi OS (Arm64)
Raspberry Pi OS (Arm64)
Re: New UserLib command: SortStructuredArrayFS()
@netmaestro,
I see your SortStructuredArrayFS procedure also use quick sort.
Is your implementation a stable sort ?
I see your SortStructuredArrayFS procedure also use quick sort.
Is your implementation a stable sort ?
Windows (x64)
Raspberry Pi OS (Arm64)
Raspberry Pi OS (Arm64)