PureBasic's built-in sorting routines for arrays and lists are limited.
They cannot be used e.g. for
- sorting lists/arrays of strings by the length of the strings
- sorting lists/arrays of strings according to self-defined rules (there are different rules for different languages, especially with regard to special characters)
- sorting lists/arrays of strings that contain numbers numerically (instead, they are always sorted alphabetically like other strings, so that e.g. 11 goes before 7)
- sorting lists/arrays of structures by more than one field
- sorting lists/arrays of arrays
- sorting lists/arrays of pointers according to the content of their targets
Custom sort for arrays can be done with a trick that wilbert has demonstrated.
The module
A stable hybrid sorting algorithm is used here: Longer lists are sorted by the fastest recursive PureBasic implementation of MergeSort that I'm aware of, shorter lists are sorted by an efficient InsertionSort implementation. The used threshold between "long" and "short" can be changed at runtime. A small program for testing the speed when using different thresholds is in the 3rd post here. No data are copied at all, all sorting is done by manipulating pointers.
This module contains individual procedures for sorting lists of integers, doubles, strings, and pointers.
A problem arises with structures: PureBasic doesn't allow us to write generic procedures that work for all data types, and a module like this can't contain separate procedures for all possible structures. So the module provides the public macro SortListAny(), which internally creates a list of pointers to the structures, then sorts the pointer list and finally rearranges the original structure list according to the order of the pointers. This is still considerably faster than the in-place version of MergeSort which this module used up to version 1.10.
// edit 2019-03-03:
In the meantime, wilbert has posted nifty code that does non-recursive custom sort for Linked Lists, which is even faster than my following code.
Code: Select all
; -- Custom sort for linked lists
; <https://www.purebasic.fr/english/viewtopic.php?f=12&t=71677>
; Version 1.22, 2019-01-31
; Purebasic 5.20 LTS or newer is required because of the module.
; Cross-platform, x86 and x64, Unicode compliant.
; This module uses a hybrid sorting algorithm. For lists of a
; size bigger than the internal threshold (value of variable
; 'sInsertionSortMaxSize'), it uses MergeSort, for smaller lists
; (including those that are always produced by MergeSort as
; intermediate results), InsertionSort is used. This is
; considerably faster than using MergeSort alone. By calling
; SetInsertionSortMaxSize(), your code can change the threshold
; at runtime.
; Your code must provide a custom comparison callback function
; of type 'ProtoCompare' (see the beginning of the module, and
; examples in the demo code). If the comparison function is
; written properly, then sorting by the procedures of this
; module is stable.
; ------------------------------------------------------------------------------
; MIT License
;
; Copyright (c) 2018-2019 Jürgen Lüthje <http://luethje.eu/>
;
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
;
; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software.
;
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
; SOFTWARE.
; ------------------------------------------------------------------------------
DeclareModule CS
EnableExplicit
Declare.i SetInsertionSortMaxSize (insSortMaxSize.i)
Declare SortListI (List a.i(), *Compare, mode.i=#PB_Sort_Ascending, first.i=0, last.i=-1)
Declare SortListD (List a.d(), *Compare, mode.i=#PB_Sort_Ascending, first.i=0, last.i=-1)
Declare SortListS (List a.s(), *Compare, mode.i=#PB_Sort_Ascending, first.i=0, last.i=-1)
Declare SortListPtr (List *a(), *Compare, mode.i=#PB_Sort_Ascending, first.i=0, last.i=-1)
Macro RearrangeData (_dataList_, _pointerList_)
; -- rearrange the elements of _dataList_ according to the order of elements in _pointerList_
ForEach _pointerList_
ChangeCurrentElement(_dataList_, _pointerList_)
MoveElement(_dataList_, #PB_List_Last)
Next
EndMacro
NewList *ptr() ; * for internal use by Macro SortListAny() only *
Macro SortListAny (_list_, _compare_, _mode_=#PB_Sort_Ascending, _first_=0, _last_=-1)
; -- sort any kind of list (indirectly by pointers)
ForEach _list_
AddElement(CS::*ptr())
CS::*ptr() = @ _list_
Next
CS::SortListPtr(CS::*ptr(), _compare_, _mode_, _first_, _last_)
CS::RearrangeData(_list_, CS::*ptr())
ClearList(CS::*ptr())
EndMacro
EndDeclareModule
Module CS
Prototype.i ProtoCompare (*a, *b, mode.i)
Define sInsertionSortMaxSize.i = 40
Procedure.i SetInsertionSortMaxSize (insSortMaxSize.i)
; -- For maximum sorting speed, you might need to change the value of the
; internal variable 'sInsertionSortMaxSize'.
; in : insSortMaxSize: new value of the internal variable 'sInsertionSortMaxSize'
; out: return value : old value of the internal variable 'sInsertionSortMaxSize',
; or 0 on error
Shared sInsertionSortMaxSize
If insSortMaxSize >= 1
Swap sInsertionSortMaxSize, insSortMaxSize
ProcedureReturn insSortMaxSize
Else
ProcedureReturn 0
EndIf
EndProcedure
;------------------------------------------------------------------------------------------------------
Macro _Merge (_listA_, _listB_)
; -- merge two sorted linked lists
; in : _listA_, _listB_: partial lists which are already sorted (both lists are not empty)
; out: _listA_ : sorted list that contains all elements of _listA_ and _listB_
; -- merge both partial lists
*curA = LastElement(_listA_)
MergeLists(_listB_, _listA_) ; Append _listB_ to the end of _listA_.
*curB = NextElement(_listA_)
If IsInWrongOrder(*curA, *curB, SortMode) > 0
countA = 0
*curA = FirstElement(_listA_)
; -- rearrange the elements in the merged list
While countA < firstB And *curB <> #Null
If IsInWrongOrder(*curA, *curB, SortMode) > 0
ChangeCurrentElement(_listA_, *curB)
*nxtB = NextElement(_listA_)
ChangeCurrentElement(_listA_, *curB)
MoveElement(_listA_, #PB_List_Before, *curA)
*curB = *nxtB
Else
countA + 1
EndIf
*curA = NextElement(_listA_) ; *curA always points to the first element which is not yet sorted.
Wend
EndIf
EndMacro
Macro _InsertionSort (_list_)
FirstElement(_list_)
While NextElement(_list_) <> #Null
*curElement = @ _list_ ; save pointer to current element
*target = *curElement
*lastSortedElement = PreviousElement(_list_)
*prevElement = *lastSortedElement
While *prevElement <> #Null And IsInWrongOrder(*prevElement, *curElement, SortMode) > 0
*target = *prevElement
*prevElement = PreviousElement(_list_)
Wend
ChangeCurrentElement(_list_, *curElement)
If *target <> *curElement
MoveElement(_list_, #PB_List_Before, *target)
ChangeCurrentElement(_list_, *lastSortedElement)
EndIf
Wend
EndMacro
Macro _SortRange (_ProcSuffix_, _list_)
; -- select the part of the list that needs to be sorted
If first = 0
If last = -1 Or last = ListSize(_list_) - 1
; -- Sort all elements
_Sort#_ProcSuffix_(_list_)
ElseIf 0 < last And last < ListSize(_list_) - 1
; -- Sort leading part of the list
SelectElement(_list_, last)
SplitList(_list_, t(), #True) ; Move the trailing part of _list_ to t().
_Sort#_ProcSuffix_(_list_) ; Sort rest of _list_.
MergeLists(t(), _list_) ; Move the saved trailing part back to _list_.
EndIf
ElseIf 0 < first And first < ListSize(_list_) - 1
If last = -1 Or last = ListSize(_list_) - 1
; -- Sort trailing part of the list
SelectElement(_list_, first)
SplitList(_list_, t()) ; Move the trailing part of _list_ to t().
_Sort#_ProcSuffix_(t()) ; Sort t().
MergeLists(t(), _list_) ; Move the sorted trailing part back to _list_.
ElseIf 0 < last And last < ListSize(_list_) - 1
; -- Sort middle part of the list
SelectElement(_list_, last)
SplitList(_list_, t(), #True) ; Move the trailing part of _list_ to t().
SelectElement(_list_, first)
SplitList(_list_, m()) ; Move the middle part of _list_ to m().
_Sort#_ProcSuffix_(m()) ; Sort m().
MergeLists(m(), _list_) ; Move the sorted middle part back to _list_.
MergeLists(t(), _list_) ; Move the saved trailing part back to _list_.
EndIf
EndIf
EndMacro
Global IsInWrongOrder.ProtoCompare
Global SortMode.i
;------------------------------------------------------------------------------------------------------
Procedure _SortI (List a.i())
Shared sInsertionSortMaxSize
Protected *target
Protected *curA, *curB, *nxtB, countA, firstB ; for _Merge()
Protected *curElement, *lastSortedElement, *prevElement ; for _InsertionSort()
Protected NewList b.i()
If ListSize(a()) <= 1
ProcedureReturn
EndIf
If ListSize(a()) > sInsertionSortMaxSize
firstB = Int(ListSize(a()) / 2)
SelectElement(a(), firstB)
SplitList(a(), b()) ; Move the second half of a() to b().
_SortI(a())
_SortI(b())
_Merge(a(), b())
Else
_InsertionSort(a())
EndIf
EndProcedure
Procedure SortListI (List a.i(), *Compare, mode.i=#PB_Sort_Ascending, first.i=0, last.i=-1)
; -- Sort list a() according to the given comparison function
; in : a() : List of integers to be sorted
; *Compare: address of a custom comparison function of type 'ProtoCompare'
; mode : This value is just passed to the custom comparison function.
; first : index of first element to sort (default: sort ... )
; last : index of last element to sort (... the whole list)
; out: a() : completely or partly sorted list
Protected NewList m.i()
Protected NewList t.i()
IsInWrongOrder = *Compare
SortMode = mode
_SortRange(I, a())
EndProcedure
;------------------------------------------------------------------------------------------------------
Procedure _SortD (List a.d())
Shared sInsertionSortMaxSize
Protected *target
Protected *curA, *curB, *nxtB, countA, firstB ; for _Merge()
Protected *curElement, *lastSortedElement, *prevElement ; for _InsertionSort()
Protected NewList b.d()
If ListSize(a()) <= 1
ProcedureReturn
EndIf
If ListSize(a()) > sInsertionSortMaxSize
firstB = Int(ListSize(a()) / 2)
SelectElement(a(), firstB)
SplitList(a(), b()) ; Move the second half of a() to b().
_SortD(a())
_SortD(b())
_Merge(a(), b())
Else
_InsertionSort(a())
EndIf
EndProcedure
Procedure SortListD (List a.d(), *Compare, mode.i=#PB_Sort_Ascending, first.i=0, last.i=-1)
; -- Sort list a() according to the given comparison function
; in : a() : List of doubles to be sorted
; *Compare: address of a custom comparison function of type 'ProtoCompare'
; mode : This value is just passed to the custom comparison function.
; first : index of first element to sort (default: sort ... )
; last : index of last element to sort (... the whole list)
; out: a() : completely or partly sorted list
Protected NewList m.d()
Protected NewList t.d()
IsInWrongOrder = *Compare
SortMode = mode
_SortRange(D, a())
EndProcedure
;------------------------------------------------------------------------------------------------------
Procedure _SortS (List a.s())
Shared sInsertionSortMaxSize
Protected *target
Protected *curA, *curB, *nxtB, countA, firstB ; for _Merge()
Protected *curElement, *lastSortedElement, *prevElement ; for _InsertionSort()
Protected NewList b.s()
If ListSize(a()) <= 1
ProcedureReturn
EndIf
If ListSize(a()) > sInsertionSortMaxSize
firstB = Int(ListSize(a()) / 2)
SelectElement(a(), firstB)
SplitList(a(), b()) ; Move the second half of a() to b().
_SortS(a())
_SortS(b())
_Merge(a(), b())
Else
_InsertionSort(a())
EndIf
EndProcedure
Procedure SortListS (List a.s(), *Compare, mode.i=#PB_Sort_Ascending, first.i=0, last.i=-1)
; -- Sort list a() according to the given comparison function
; in : a() : List of strings to be sorted
; *Compare: address of a custom comparison function of type 'ProtoCompare'
; mode : This value is just passed to the custom comparison function.
; first : index of first element to sort (default: sort ... )
; last : index of last element to sort (... the whole list)
; out: a() : completely or partly sorted list
Protected NewList m.s()
Protected NewList t.s()
IsInWrongOrder = *Compare
SortMode = mode
_SortRange(S, a())
EndProcedure
;------------------------------------------------------------------------------------------------------
Procedure _SortPtr (List *a())
Shared sInsertionSortMaxSize
Protected *target
Protected *curA, *curB, *nxtB, countA, firstB ; for _Merge()
Protected *curElement, *lastSortedElement, *prevElement ; for _InsertionSort()
Protected NewList *b()
If ListSize(*a()) <= 1
ProcedureReturn
EndIf
If ListSize(*a()) > sInsertionSortMaxSize
firstB = Int(ListSize(*a()) / 2)
SelectElement(*a(), firstB)
SplitList(*a(), *b()) ; Move the second half of *a() to *b().
_SortPtr(*a())
_SortPtr(*b())
_Merge(*a(), *b())
Else
_InsertionSort(*a())
EndIf
EndProcedure
Procedure SortListPtr (List *a(), *Compare, mode.i=#PB_Sort_Ascending, first.i=0, last.i=-1)
; -- Sort list *a() according to the given comparison function
; in : *a() : List of pointers to be sorted according to their targets
; *Compare: address of a custom comparison function of type 'ProtoCompare'
; mode : This value is just passed to the custom comparison function.
; first : index of first element to sort (default: sort ... )
; last : index of last element to sort (... the whole list)
; out: *a() : completely or partly sorted list
Protected NewList m.i()
Protected NewList t.i()
IsInWrongOrder = *Compare
SortMode = mode
_SortRange(Ptr, *a())
EndProcedure
;-=====================================================================================================
EndModule
CompilerIf #PB_Compiler_IsMainFile
; -- Module demo
CompilerIf #PB_Compiler_Debugger = #False
MessageRequester("Error",
"Switch Debugger on to see the demo.",
#PB_MessageRequester_Error)
End
CompilerEndIf
EnableExplicit
Debug "Old value of 'sInsertionSortMaxSize': " + CS::SetInsertionSortMaxSize(3)
Debug ""
Define first, last, k, prefix$
Macro ShowList (_list_, _first_=99, _last_=99)
Debug ""
k = 0
ForEach _list_
If _first_ <= k And k <= _last_
prefix$ = "> "
Else
prefix$ = " "
EndIf
Debug Str(k) + ") " + prefix$ + _list_
k + 1
Next
EndMacro
;================================================================
Procedure.i CompareI (*a.Integer, *b.Integer, mode.i)
; -- custom comparison function of type 'ProtoCompare' (see Module CS)
; in : *a, *b: pointers to integers to be compared
; mode : mode of comparison:
; #PB_Sort_Ascending/#PB_Sort_Descending
; out: return value: < 0, 0, or > 0
If (mode & #PB_Sort_Descending)
ProcedureReturn *b\i - *a\i
Else
ProcedureReturn *a\i - *b\i
EndIf
EndProcedure
NewList i.i()
For k = 0 To 6
AddElement(i())
i() = k
Next
Debug "Integers shuffled:"
RandomizeList(i())
ShowList(i())
Debug "-----------------------------------------"
Debug "Whole integer list sorted ascending:"
CS::SortListI(i(), @ CompareI(), #PB_Sort_Ascending)
ShowList(i(), 0, 6)
Debug "-----------------------------------------"
Debug "Whole integer list sorted descending:"
CS::SortListI(i(), @ CompareI(), #PB_Sort_Descending)
ShowList(i(), 0, 6)
Debug ""
Debug "========================================="
Debug ""
Procedure.i CompareD (*a.Double, *b.Double, mode.i)
; -- custom comparison function of type 'ProtoCompare' (see Module CS)
; in : *a, *b: pointers to doubles to be compared
; mode : mode of comparison:
; #PB_Sort_Ascending/#PB_Sort_Descending
; out: return value: #True/#False
If (mode & #PB_Sort_Descending)
ProcedureReturn Bool(*a\d < *b\d)
Else
ProcedureReturn Bool(*a\d > *b\d)
EndIf
EndProcedure
NewList d.d()
For k = 0 To 6
AddElement(d())
d() = k * 0.4
Next
Debug "Doubles shuffled:"
RandomizeList(d())
ShowList(d())
first = 2
Debug "-----------------------------------------"
Debug "Doubles from #" + first + " to last element sorted ascending:"
CS::SortListD(d(), @ CompareD(), #PB_Sort_Ascending, first)
ShowList(d(), first)
Debug "-----------------------------------------"
Debug "Doubles from #" + first + " to last element sorted descending:"
CS::SortListD(d(), @ CompareD(), #PB_Sort_Descending, first)
ShowList(d(), first)
Debug ""
Debug "========================================="
Debug ""
Procedure.i CompareS (*a.String, *b.String, mode.i)
; -- custom comparison function of type 'ProtoCompare' (see Module CS)
; in : *a, *b: pointers to strings to be compared
; mode : mode of comparison:
; #PB_Sort_Ascending/#PB_Sort_Descending/#PB_Sort_NoCase
; out: return value: < 0, 0, or > 0
Protected ret.i=0
If (mode & #PB_Sort_NoCase)
ret = CompareMemoryString(@ *a\s, @ *b\s, #PB_String_NoCase)
Else
ret = CompareMemoryString(@ *a\s, @ *b\s)
EndIf
If (mode & #PB_Sort_Descending)
ProcedureReturn -ret
Else
ProcedureReturn ret
EndIf
EndProcedure
DataSection
StringData:
Data.s "aaaaaaaaaa"
Data.s "bbbbbbbbbb"
Data.s "cccccccc"
Data.s "dddddddd"
Data.s "eeeeee"
Data.s "ffffff"
Data.s "gggggg"
Data.s ""
EndDataSection
Procedure ReadStrings (List s.s())
Protected temp$
Restore StringData
Read.s temp$
While temp$
AddElement(s())
s() = temp$
Read.s temp$
Wend
EndProcedure
NewList s.s()
ReadStrings(s())
Debug "Strings shuffled:"
RandomizeList(s())
ShowList(s())
first = 0 : last = 5
Debug "-----------------------------------------"
Debug "Strings from #" + first + " to #" + last + " sorted ascending:"
CS::SortListS(s(), @ CompareS(), #PB_Sort_Ascending, first, last)
ShowList(s(), first, last)
Debug "-----------------------------------------"
Debug "Strings from #" + first + " to #" + last + " sorted descending:"
CS::SortListS(s(), @ CompareS(), #PB_Sort_Descending, first, last)
ShowList(s(), first, last)
Debug ""
Debug "========================================="
Debug ""
Structure Person
FamilyName.s
GivenName.s
Age.i
EndStructure
Enumeration 0 Step 4
#ByFamilyName
#ByGivenName
#ByAge
EndEnumeration
Procedure.i ComparePtr (*pa.Integer, *pb.Integer, mode.i)
; -- custom comparison function of type 'ProtoCompare' (see Module CS)
; in : *pa, *pb: pointers to pointers to data to be compared
; mode : mode of comparison:
; number for structure field that is used for comparison, combined
; with #PB_Sort_Ascending/#PB_Sort_Descending/#PB_Sort_NoCase
; out: return value: #True/#False
;
; CAVE! When using '<=' instead of '<' or '>=' instead of '>' here,
; sorting will work but won't be stable!
Protected.Person *a = *pa\i, *b = *pb\i ; dereference the pointers passed as parameters
Select mode
; -- by family name
Case 0 ; ascending
ProcedureReturn Bool(*a\FamilyName > *b\FamilyName)
Case 1 ; descending
ProcedureReturn Bool(*a\FamilyName < *b\FamilyName)
Case 2 ; ascending and case-insensitive
ProcedureReturn Bool(UCase(*a\FamilyName) > UCase(*b\FamilyName))
Case 3 ; descending and case-insensitive
ProcedureReturn Bool(UCase(*a\FamilyName) < UCase(*b\FamilyName))
; -- by given name
Case 4 ; ascending
ProcedureReturn Bool(*a\GivenName > *b\GivenName)
Case 5 ; descending
ProcedureReturn Bool(*a\GivenName < *b\GivenName)
Case 6 ; ascending and case-insensitive
ProcedureReturn Bool(UCase(*a\GivenName) > UCase(*b\GivenName))
Case 7 ; descending and case-insensitive
ProcedureReturn Bool(UCase(*a\GivenName) < UCase(*b\GivenName))
; -- by age
Case 8 ; ascending
ProcedureReturn Bool(*a\Age > *b\Age)
Case 9 ; descending
ProcedureReturn Bool(*a\Age < *b\Age)
EndSelect
EndProcedure
DataSection
People:
Data.s "Schmidt", "Michelle"
Data.i 50
Data.s "Johnson", "Jamie"
Data.i 40
Data.s "Schmidt", "Jürgen"
Data.i 30
Data.s "Miller", "Mary"
Data.i 40
Data.s "Parker", "Peter"
Data.i 20
Data.s "Johnson", "Karl"
Data.i 30
Data.s "Parker", "Michelle"
Data.i 60
Data.s ""
EndDataSection
Procedure GetData (List x.Person())
Protected temp$
Restore People
Read.s temp$
While temp$
AddElement(x())
x()\FamilyName = temp$
Read.s x()\GivenName
Read.i x()\Age
Read.s temp$
Wend
EndProcedure
Procedure ShowData (List x.Person(), first.i=99, last.i=99)
Protected k.i, prefix$
Debug ""
k = 0
ForEach x()
If first <= k And k <= last
prefix$ = "> "
Else
prefix$ = " "
EndIf
With x()
Debug Str(k) + ") " + prefix$ + LSet(\FamilyName + ", " + \GivenName + ", ", 20) + \Age
EndWith
k + 1
Next
EndProcedure
Procedure ShowTargets (List *p(), first.i=99, last.i=99)
Protected k.i, prefix$, *temp.Person
Debug ""
k = 0
ForEach *p()
If first <= k And k <= last
prefix$ = "> "
Else
prefix$ = " "
EndIf
*temp = *p()
With *temp
Debug Str(k) + ") " + prefix$ + LSet(\FamilyName + ", " + \GivenName + ", ", 20) + \Age
EndWith
k + 1
Next
EndProcedure
NewList x.Person()
NewList *p()
GetData(x())
RandomizeList(x())
ForEach x()
AddElement(*p())
*p() = @ x()
Next
Debug "Pointers to shuffled data:"
ShowTargets(*p())
first = 1 : last = 5
Debug "-----------------------------------------"
Debug "Pointers from #" + first + " to #" + last + " sorted ascending by family name (stable):"
CS::SortListPtr(*p(), @ ComparePtr(), #PB_Sort_Ascending|#ByFamilyName, first, last)
ShowTargets(*p(), first, last)
Debug "-----------------------------------------"
Debug "Pointers from #" + first + " to #" + last + " sorted descending by age (stable):"
CS::SortListPtr(*p(), @ ComparePtr(), #PB_Sort_Descending|#ByAge, first, last)
ShowTargets(*p(), first, last)
Debug "-----------------------------------------"
Debug "The original data are still unsorted:"
ShowData(x())
Debug "-----------------------------------------"
Debug "Now the original data are sorted, too"
Debug "(according to the current order of the pointers):"
CS::RearrangeData(x(), *p())
ShowData(x(), first, last)
Debug ""
Debug "========================================="
Debug ""
Structure Country
Name.s
Capital.s
Population.i
EndStructure
Enumeration 0 Step 4
#ByName
#ByCapital
#ByPopulation
EndEnumeration
Procedure.i CompareStruc (*pa.Integer, *pb.Integer, mode.i)
; -- custom comparison function of type 'ProtoCompare'
; in : *pa, *pb: pointers to pointers to structures to be compared
; mode : mode of comparison:
; number for structure field that is used for comparison, combined
; with #PB_Sort_Ascending/#PB_Sort_Descending/#PB_Sort_NoCase
; out: return value: #True/#False
;
; CAVE! When using '<=' instead of '<' or '>=' instead of '>' here,
; sorting will work but won't be stable!
Protected.Country *a = *pa\i, *b = *pb\i ; dereference the pointers passed as parameters
Select mode
; -- by name
Case 0 ; ascending
ProcedureReturn Bool(*a\Name > *b\Name)
Case 1 ; descending
ProcedureReturn Bool(*a\Name < *b\Name)
Case 2 ; ascending and case-insensitive
ProcedureReturn Bool(UCase(*a\Name) > UCase(*b\Name))
Case 3 ; descending and case-insensitive
ProcedureReturn Bool(UCase(*a\Name) < UCase(*b\Name))
; -- by capital
Case 4 ; ascending
ProcedureReturn Bool(*a\Capital > *b\Capital)
Case 5 ; descending
ProcedureReturn Bool(*a\Capital < *b\Capital)
Case 6 ; ascending and case-insensitive
ProcedureReturn Bool(UCase(*a\Capital) > UCase(*b\Capital))
Case 7 ; descending and case-insensitive
ProcedureReturn Bool(UCase(*a\Capital) < UCase(*b\Capital))
; -- by population
Case 8 ; ascending
ProcedureReturn Bool(*a\Population > *b\Population)
Case 9 ; descending
ProcedureReturn Bool(*a\Population < *b\Population)
EndSelect
EndProcedure
DataSection
Countries:
Data.s "France", "Paris"
Data.i 67348000
Data.s "England", "London"
Data.i 55619400
Data.s "Japan", "Tokyo"
Data.i 126440000
Data.s "New Zealand", "Wellington"
Data.i 4915240
Data.s "Germany", "Berlin"
Data.i 82800000
Data.s "Canada", "Ottawa"
Data.i 37067011
Data.s "China", "Beijing"
Data.i 1403500365
Data.s ""
EndDataSection
Procedure ReadStruc (List x.Country())
Protected temp$
Restore Countries
Read.s temp$
While temp$
AddElement(x())
x()\Name = temp$
Read.s x()\Capital
Read.i x()\Population
Read.s temp$
Wend
EndProcedure
Procedure ShowStruc (List r.Country(), first.i=99, last.i=99)
Protected k.i, prefix$
Debug ""
k = 0
ForEach r()
If first <= k And k <= last
prefix$ = "> "
Else
prefix$ = " "
EndIf
With r()
Debug Str(k) + ") " + prefix$ + LSet(\Name + ", " + \Capital + ", ", 26) + RSet(Str(\Population), 10)
EndWith
k + 1
Next
EndProcedure
NewList r.Country()
ReadStruc(r())
RandomizeList(r())
Debug "Shuffled structured list:"
ShowStruc(r())
Debug "-----------------------------------------"
Debug "Whole structured list sorted ascending by name:"
CS::SortListAny(r(), @ CompareStruc(), #PB_Sort_Ascending|#ByName)
ShowStruc(r(), 0, 6)
Debug "-----------------------------------------"
Debug "Whole structured list sorted descending by population:"
CS::SortListAny(r(), @ CompareStruc(), #PB_Sort_Descending|#ByPopulation)
ShowStruc(r(), 0, 6)
CompilerEndIf
