# PureBasic Forum

 It is currently Thu May 28, 2020 10:16 pm

 All times are UTC + 1 hour

 Page 1 of 1 [ 15 posts ]
 Print view Previous topic | Next topic
Author Message
 Post subject: Non-recursive custom sort for Linked ListsPosted: Mon Feb 25, 2019 10:09 am
 PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3609
Location: Netherlands
A few months ago, Little John posted a module for sorting linked lists.
viewtopic.php?f=12&t=71677
I was curious about a non-recursive sort; how it would perform and how difficult it would be to create.
So here's my attempt at a non-recursive sort.
If you find any bugs please let me know.

Update March 2, 2019 : Improved performance for lists that are mostly in reverse order

Code:
DeclareModule SortLinkedList

; v 1.10  March 2, 2019

; Procedure Compare(*p1, *p2)
; <0 The element pointed to by *p1 goes before the element pointed to by *p2
;  0 The element pointed to by *p1 is equivalent to the element pointed to by *p2
; >0 The element pointed to by *p1 goes after the element pointed to by *p2

Declare _SortLinkedList_ (*LinkedList, *Compare, First=0, Last=-1)

Declare SortLinkedListD (List LinkedList.d(), *Compare, First=0, Last=-1)
Declare SortLinkedListI (List LinkedList.i(), *Compare, First=0, Last=-1)
Declare SortLinkedListS (List LinkedList.s(), *Compare, First=0, Last=-1)

EndDeclareModule

Module SortLinkedList

DisableDebugger
EnableExplicit

;- >> Structures <<

Structure PB_ListHeader
*Next.PB_ListHeader
*Previous.PB_ListHeader
Element.i[0]
EndStructure

Structure PB_List
*First.PB_ListHeader
*Last.PB_ListHeader
*Current.PB_ListHeader
*PtrCurrentVariable.Integer
NBElements.i
Index.i
*StructureMap
*Allocator
*PositionStack
*Object
ElementSize.i
ElementType.l
IsIndexInvalid.b
IsDynamic.b
IsDynamicObject.b
EndStructure

;- >> Prototypes <<

Prototype.i ProtoCompare (*p1, *p2)
Prototype Proto_SortLinkedListD (List LinkedList.d(), *Compare, First=0, Last=-1)
Prototype Proto_SortLinkedListI (List LinkedList.i(), *Compare, First=0, Last=-1)
Prototype Proto_SortLinkedListS (List LinkedList.s(), *Compare, First=0, Last=-1)

;- >> Procedures <<

Procedure _SortLinkedList_ (*LinkedList.PB_List, *Compare.ProtoCompare, First=0, Last=-1)
Protected Dim *ListHead(31)
Protected Dim *ListTail(31)
Protected.PB_ListHeader *EqualItems, *List, *List1, *List2, *Next, *P, *Stop, *Tail, *Tail1, *Tail2
Protected.i Count, Direction, Fractional, FractionalCount, i, ListSize0, NumItems, NumLists

; Check parameters and return if there is nothing to sort
If *LinkedList And *Compare And *LinkedList\NBElements
If First < 0 : First = 0 : EndIf
If Last < 0 Or Last >= *LinkedList\NBElements
Last = *LinkedList\NBElements - 1
EndIf
NumItems = Last - First + 1
If NumItems <= 1
ProcedureReturn
EndIf
Else
ProcedureReturn
EndIf

; Invalidate the current index value
*LinkedList\IsIndexInvalid = #True

; Seek the first element to sort
If First << 1 < *LinkedList\NBElements
; Seek element starting from beginning
i = First
*List = *LinkedList\First
While i
*List = *List\Next
i - 1
Wend
Else
; Seek element starting from end
i = *LinkedList\NBElements - 1 - First
*List = *LinkedList\Last
While i
*List = *List\Previous
i - 1
Wend
EndIf

; Store pointer to previous element
*P = *List\Previous

; Calculate the initial list size so that
; the number of lists is a power of two
ListSize0 = NumItems >> 3
For i = 0 To 5
ListSize0 | ListSize0 >> (1 << i)
Next
NumLists = ListSize0 + 1
ListSize0 = NumItems / NumLists
Fractional = NumItems - NumLists * ListSize0

;- >> Sort <<
While NumItems

;- >> Build list using insertion sort <<
*Next = *List\Next
*Tail = *List
*List\Next = #Null
*List\Previous = #Null
*List1 = *List
*EqualItems = #Null
Direction = 0

Count = ListSize0
FractionalCount + Fractional
If FractionalCount >= NumLists
FractionalCount - NumLists
Count + 1
EndIf
NumItems - Count

While Count > 1
*List2 = *Next
*Next = *List2\Next

; Compare against previous insertion point
i = *Compare(@*List1\Element, @*List2\Element)
If i = 0
; No search; insert directly after previous insertion point
If *EqualItems = #Null
*EqualItems = *List1
EndIf
*Stop = *List1
Else
If i > 0
; Search back from previous insertion point
If *EqualItems
*List1 = *EqualItems
EndIf
*Stop = #Null
*List1 = *List1\Previous
If Direction And Direction <> -1
Direction = -2
Else
Direction = -1
EndIf
Else
; Search back from tail
*Stop = *List1
*List1 = *Tail
If Direction And Direction <> 1
Direction = -2
Else
Direction = 1
EndIf
EndIf
*EqualItems = #Null
EndIf
; Backward search
While *List1 <> *Stop And *Compare(@*List1\Element, @*List2\Element) > 0
*List1 = *List1\Previous
Wend
; Insert
If *List1
; Insert *List2 after *List1
*List2\Next = *List1\Next
*List2\Previous = *List1
If *List2\Next
*List2\Next\Previous = *List2
Else
*Tail = *List2
EndIf
*List1\Next = *List2
Else
; Insert *List2 before *List
*List2\Next = *List
*List2\Previous = #Null
*List\Previous = *List2
*List = *List2
EndIf
*List1 = *List2

Count - 1
Wend

; Merge with other list(s)
For i = 0 To 31
If *ListHead(i)
If *List
*List1 = *ListHead(i)
*Tail1 = *ListTail(i)
*List2 = *List
*Tail2 = *Tail

;- >> Merge List1 and List2 <<

If Direction = -1 And *Compare(@*List1\Element, @*Tail2\Element) > 0
; Entire List1 goes after List2
*Tail2\Next = *List1
*List1\Previous = *Tail2
*List = *List2
*Tail = *Tail1
ElseIf Direction >= 0 And *Compare(@*Tail1\Element, @*List2\Element) <= 0
; Entire List2 goes after List1
*Tail1\Next = *List2
*List2\Previous = *Tail1
*List = *List1
*Tail = *Tail2
Else
Direction = -2
; Merge List1 and List2 element by element

If *Compare(@*List1\Element, @*List2\Element) <= 0
*List = *List1
*List1 = *List1\Next
Else
*List = *List2
*List2 = *List2\Next
EndIf
*Tail = *List

While *List1 And *List2
If *Compare(@*List1\Element, @*List2\Element) <= 0
*Tail\Next = *List1
*List1\Previous = *Tail
*Tail = *List1
*List1 = *List1\Next
Else
*Tail\Next = *List2
*List2\Previous = *Tail
*Tail = *List2
*List2 = *List2\Next
EndIf
Wend

If *List1
*Tail\Next = *List1
*List1\Previous = *Tail
*Tail = *Tail1
ElseIf *List2
*Tail\Next = *List2
*List2\Previous = *Tail
*Tail = *Tail2
EndIf

EndIf

;- >> End of merge <<

Else
*List = *ListHead(i)
*Tail = *ListTail(i)
EndIf
*ListHead(i) = #Null
ElseIf NumItems
Break
EndIf
Next

If NumItems
If i > 31 : i = 31 : EndIf
*ListHead(i) = *List
*ListTail(i) = *Tail
*List = *Next
EndIf

Wend

; Update *First and *Last when needed
If First = 0
*LinkedList\First = *List
Else
*P\Next = *List
*List\Previous = *P
EndIf
If Last = *LinkedList\NBElements - 1
*LinkedList\Last = *Tail
Else
*Tail\Next = *Next
*Next\Previous = *Tail
EndIf

EndProcedure

Procedure SortLinkedListD (List LinkedList.d(), *Compare, First=0, Last=-1)
Protected SortLinkedList.Proto_SortLinkedListD = @_SortLinkedList_()
SortLinkedList(LinkedList(), *Compare, First, Last)
EndProcedure

Procedure SortLinkedListI (List LinkedList.i(), *Compare, First=0, Last=-1)
Protected SortLinkedList.Proto_SortLinkedListI = @_SortLinkedList_()
SortLinkedList(LinkedList(), *Compare, First, Last)
EndProcedure

Procedure SortLinkedListS (List LinkedList.s(), *Compare, First=0, Last=-1)
Protected SortLinkedList.Proto_SortLinkedListS = @_SortLinkedList_()
SortLinkedList(LinkedList(), *Compare, First, Last)
EndProcedure

EndModule

_________________
macOS 10.15 Catalina, PB 5.71 x64

Last edited by wilbert on Sat Mar 02, 2019 11:24 am, edited 3 times in total.

Top

 Post subject: Re: Non-recursive pointer based sort for Linked ListsPosted: Mon Feb 25, 2019 10:10 am
 PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3609
Location: Netherlands
Example ...

Code:
Dim Names.s(4)
Names(0) = "John"
Names(1) = "Mary"
Names(2) = "Jacob"
Names(3) = "Bob"
Names(4) = "Ellen"

Structure Record
Idx.i
Age.i
Name.s
EndStructure

Procedure CompareRecordsByAge(*a.Record, *b.Record)
ProcedureReturn *a\Age - *b\Age
EndProcedure

Procedure CompareRecordsByName(*a.Record, *b.Record)
ProcedureReturn CompareMemoryString(@*a\Name, @*b\Name, #PB_String_NoCase)
EndProcedure

Prototype Proto_SortRecords(List LinkedList.Record(), *Compare, First=0, Last=-1)
Global SortRecords.Proto_SortRecords = SortLinkedList::@_SortLinkedList_()

NewList Records.Record()

For i = 0 To 39
AddElement(Records())
Records()\Idx = i
Records()\Age = Random(100)
Records()\Name = Names(Random(4))
Next

SortRecords(Records(), @CompareRecordsByName())
Debug ">> By name <<"
ForEach Records()
Debug "Idx:" + Str(Records()\Idx) + "  Name:"+Records()\Name+"  Age:"+Str(Records()\Age)
Next

Debug ""

SortRecords(Records(), @CompareRecordsByAge())
Debug ">> By age <<"
ForEach Records()
Debug "Idx:" + Str(Records()\Idx) + "  Name:"+Records()\Name+"  Age:"+Str(Records()\Age)
Next

_________________
macOS 10.15 Catalina, PB 5.71 x64

Top

 Post subject: Re: Non-recursive custom sort for Linked ListsPosted: Wed Feb 27, 2019 4:34 pm
 Addict

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3845
Location: Berlin, Germany
Very interesting wilbert, many thanks for sharing the code
I'll take a closer look at it as soon as I have some time for doing so.

_________________
Please excuse my flawed English. My native language is PureBasic.
Search
RSBasic's backups

Top

 Post subject: Re: Non-recursive custom sort for Linked ListsPosted: Wed Feb 27, 2019 6:14 pm
 PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3609
Location: Netherlands
Little John wrote:
I'll take a closer look at it as soon as I have some time for doing so.

I appreciate that

_________________
macOS 10.15 Catalina, PB 5.71 x64

Top

 Post subject: Re: Non-recursive custom sort for Linked ListsPosted: Thu Feb 28, 2019 12:57 pm
 Addict

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4678
Location: Lyon - France
Works good here
Thanks for sharing

_________________
The happiness is a road...
Not a destination

Top

 Post subject: Re: Non-recursive custom sort for Linked ListsPosted: Sat Mar 02, 2019 12:36 pm
 PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3609
Location: Netherlands
I updated my code.
It should (hopefully) perform a bit better now on lists that are mostly in reverse order.

_________________
macOS 10.15 Catalina, PB 5.71 x64

Top

 Post subject: Re: Non-recursive custom sort for Linked ListsPosted: Sun Mar 03, 2019 3:45 pm
 Addict

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3845
Location: Berlin, Germany
wilbert, your code is really impressive!

As you know, I also wanted to write a non-recursive custom sort for Linked Lists. Unfortunately, I didn't find a good approach how to write code that works efficiently. So I'm very happy that you did it.

Here is some code which confirms that the results of sorting structures with your code are the same as with PB's built-in SortStructuredList().

//edit 2019-03-04:
Code slightly changed and extended, so that it also tests whether sorting is stable (PB's built-in list sort is stable).

Code:
EnableExplicit

XIncludeFile "SortLinkedLists.pbi"   ; by wilbert

Structure Person
Name.s
Age.i
EndStructure

Procedure.i CompareNames_As (*a.Person, *b.Person)
; -- custom comparison function for sorting *ascending*
; in : *a, *b: pointers to structures to be compared
; out: return value: < 0, 0, or > 0

ProcedureReturn CompareMemoryString(@*a\Name, @*b\Name)
EndProcedure

Procedure.i CompareAges_As (*a.Person, *b.Person)
; -- custom comparison function for sorting *ascending*
; in : *a, *b: pointers to structures to be compared
; out: return value: < 0, 0, or > 0

ProcedureReturn *a\Age - *b\Age
EndProcedure

Procedure.i CompareNames_Des (*a.Person, *b.Person)
; -- custom comparison function for sorting *descending*
; in : *a, *b: pointers to structures to be compared
; out: return value: < 0, 0, or > 0

ProcedureReturn CompareMemoryString(@*b\Name, @*a\Name)
EndProcedure

Procedure.i CompareAges_Des (*a.Person, *b.Person)
; -- custom comparison function for sorting *ascending*
; in : *a, *b: pointers to structures to be compared
; out: return value: < 0, 0, or > 0

ProcedureReturn *b\Age - *a\Age
EndProcedure

Procedure.s RandomString (length.i)
Protected *char.Character, ret\$=Space(length)

*char = @ ret\$
While *char\c <> 0
If Random(1) = 0
*char\c = Random('Z', 'A')
Else
*char\c = Random('z', 'a')
EndIf
*char + SizeOf(Character)
Wend

ProcedureReturn ret\$
EndProcedure

Procedure CreateRandomStructures (List x.Person(), n.i)
Protected m\$, a, i, r=Int(n/2)

For i = 1 To r
m\$ = RandomString(Random(50, 30))
a = Random(80, 20)

AddElement(x())
x()\Name = m\$
x()\Age = a

AddElement(x())
x()\Name = m\$
x()\Age = a + 10
Next
EndProcedure

Procedure.i IsEqualStructuredList (List a.Person(), List b.Person())
; check whether 2 sorted structure lists are equal

If ListSize(a()) <> ListSize(b())
ProcedureReturn #False
EndIf

FirstElement(b())
ForEach a()
If a()\Name <> b()\Name Or
a()\Age <> b()\Age
ProcedureReturn #False
EndIf
NextElement(b())
Next

ProcedureReturn #True
EndProcedure

;-===============================================================================

Define n, first, last, e1, e2, flag, msg\$=""
NewList a.Person()
NewList b.Person()

n = 3000

CreateRandomStructures(a(), n)
last  = Random(ListSize(a())-1, 1)
first = Random(last-1)

Prototype Proto_SortRecords(List LinkedList.Person(), *Compare, First=0, Last=-1)
Global SortRecords.Proto_SortRecords = SortLinkedList::@_SortLinkedList_()

; -------------------------------------------------------------------------------
; sort ascending

RandomizeList(a())
CopyList(a(), b())

SortStructuredList(a(), #PB_Sort_Ascending, OffsetOf(Person\Name), TypeOf(Person\Name), first, last)
SortStructuredList(a(), #PB_Sort_Ascending, OffsetOf(Person\Age),  TypeOf(Person\Age),  first, last)

SortRecords(b(), @ CompareNames_As(), first, last)
SortRecords(b(), @ CompareAges_As(),  first, last)

e1 = IsEqualStructuredList(a(), b())

; -------------------------------------------------------------------------------
; sort descending

RandomizeList(a())
CopyList(a(), b())

SortStructuredList(a(), #PB_Sort_Descending, OffsetOf(Person\Name), TypeOf(Person\Name), first, last)
SortStructuredList(a(), #PB_Sort_Descending, OffsetOf(Person\Age),  TypeOf(Person\Age),  first, last)

SortRecords(b(), @ CompareNames_Des(), first, last)
SortRecords(b(), @ CompareAges_Des(),  first, last)

e2 = IsEqualStructuredList(a(), b())

; -------------------------------------------------------------------------------

If e1 = #False : msg\$ + ", e1" : EndIf
If e2 = #False : msg\$ + ", e2" : EndIf

If Asc(msg\$) = ''
msg\$ = ~"Stable sorting structures ascending and descending:\nOK"
flag = #PB_MessageRequester_Info
Else
msg\$ = "False: " + Mid(msg\$, 3)
flag = #PB_MessageRequester_Warning
EndIf

MessageRequester("Validation", msg\$, flag)

_________________
Please excuse my flawed English. My native language is PureBasic.
Search
RSBasic's backups

Last edited by Little John on Mon Mar 04, 2019 2:49 pm, edited 2 times in total.

Top

 Post subject: Re: Non-recursive custom sort for Linked ListsPosted: Sun Mar 03, 2019 3:54 pm
 Addict

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3845
Location: Berlin, Germany
Here is a speed comparison of PB's internal sort, your custom sort, and mine.
The speed of your custom sort is impressive! I'll add a respective comment and a link to this thread to the first post of the thread with my custom sort.

//edit 2019-03-04:
Code corrected and extended.

Code:
EnableExplicit

XIncludeFile "SortListCustom.pbi"       ; by Little Jpohn
XIncludeFile "SortLinkedList_110.pbi"   ; by wilbert
XIncludeFile "SortLinkedList_120.pbi"   ; by wilbert

CompilerIf #PB_Compiler_Debugger
MessageRequester("Error",
"Switch the Debugger off!",
#PB_MessageRequester_Error)
End
CompilerEndIf

Procedure.s RandomString (length.i)
Protected *char.Character, ret\$=Space(length)

*char = @ ret\$
While *char\c <> 0
If Random(1) = 0
*char\c = Random('Z', 'A')
Else
*char\c = Random('z', 'a')
EndIf
*char + SizeOf(Character)
Wend

ProcedureReturn ret\$
EndProcedure

Define msg\$, n = 500000

;-============  Strings  ============

Macro StorePointers (_dataList_, _pointerList_)
; -- create _pointerList_, that contains the addresses of the elements of _dataList_

ClearList(_pointerList_)
ForEach _dataList_
AddElement(_pointerList_)
_pointerList_ = @ _dataList_
Next
EndMacro

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

Procedure CreateRandomStrings (List x.s(), n.i)
Protected i

For i = 1 To n
AddElement(x())
x() = RandomString(Random(1000, 200))
Next
EndProcedure

Procedure.i CompareS (*a.String, *b.String, mode.i)
; -- custom comparison function of type 'ProtoCompare'
; in : *a, *b: pointers to strings to be compared
;      mode  : mode of comparison:
;              #PB_Sort_Ascending/#PB_Sort_Descending
; out: return value: -1 / 0 / 1

ProcedureReturn CompareMemoryString(@*a\s, @*b\s)
EndProcedure

Procedure.i CompareS_w (*a.String, *b.String)
; -- custom comparison function for sorting *ascending*
; in : *a, *b: pointers to strings to be compared
; out: return value: -1 / 0 / 1

ProcedureReturn CompareMemoryString(@*a\s, @*b\s)
EndProcedure

Define t0, t1, t2, t3
NewList s0.s()
NewList *s0()

CreateRandomStrings(s0(), n)
StorePointers(s0(), *s0())

; --------------------------------------------------------------------------
Prototype Proto_SortStrings (List LinkedList\$(), *Compare, First=0, Last=-1)
Global SortStrings_110.Proto_SortStrings = SortLinkedList_110::@_SortLinkedList_()
Global SortStrings_120.Proto_SortStrings = SortLinkedList_120::@_SortLinkedList_()

t0 = ElapsedMilliseconds()
SortList(s0(), #PB_Sort_Ascending)
t0 = ElapsedMilliseconds() - t0

RearrangeData(s0(), *s0())
t1 = ElapsedMilliseconds()
SortStrings_110(s0(), @ CompareS_w())
t1 = ElapsedMilliseconds() - t1

RearrangeData(s0(), *s0())
t2 = ElapsedMilliseconds()
SortStrings_120(s0(), @ CompareS_w())
t2 = ElapsedMilliseconds() - t2

RearrangeData(s0(), *s0())
CS::SetInsertionSortMaxSize(40)
t3 = ElapsedMilliseconds()
CS::SortListS(s0(), @ CompareS())
t3 = ElapsedMilliseconds() - t3

; --------------------------------------------------------------------------

msg\$ = "-- Sorting strings" + #LF\$ +
"t0 = " + StrD(t0/1000,3) + " Sec. (built-in MergeSort)" + #LF\$ +
"t1 = " + StrD(t1/1000,3) + " Sec. (wilbert v1.10)" + #LF\$ +
"t2 = " + StrD(t2/1000,3) + " Sec. (wilbert v1.20)" + #LF\$ +
"t3 = " + StrD(t3/1000,3) + " Sec. (Little John)" + #LF\$ +
#LF\$

;-============  Structures  ============

Structure Person
Idx.i
Name.s
Age.i
EndStructure

Procedure CreateRandomStructures (List x.Person(), n.i)
Protected m\$, a, i, r=Int(n/2)

For i = 1 To r
m\$ = RandomString(Random(1000, 200))
a = Random(80, 20)

AddElement(x())
x()\Idx = i*2 - 1
x()\Name = m\$
x()\Age = a

AddElement(x())
x()\Idx = i*2
x()\Name = m\$
x()\Age = a + 10
Next
EndProcedure

Procedure.i ComparePersons (*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:
;                #PB_Sort_Ascending/#PB_Sort_Descending
; out: return value: < 0, 0, or > 0
Protected.Person *a = *pa\i, *b = *pb\i     ; dereference the pointers passed as parameters

ProcedureReturn CompareMemoryString(@*a\Name, @*b\Name)
EndProcedure

Procedure.i ComparePersons_w (*a.Person, *b.Person)
; -- custom comparison function for sorting *ascending*
; in : *a, *b: pointers to structures to be compared
; out: return value: < 0, 0, or > 0

ProcedureReturn CompareMemoryString(@*a\Name, @*b\Name)
EndProcedure

Define u0, u1, u2, u3
NewList p0.Person()

CreateRandomStructures(p0(), n)

; --------------------------------------------------------------------------
Prototype Proto_SortRecords(List LinkedList.Person(), *Compare, First=0, Last=-1)
Global SortRecords_110.Proto_SortRecords = SortLinkedList_110::@_SortLinkedList_()
Global SortRecords_120.Proto_SortRecords = SortLinkedList_120::@_SortLinkedList_()

u0 = ElapsedMilliseconds()
SortStructuredList(p0(), #PB_Sort_Ascending, OffsetOf(Person\Name), TypeOf(Person\Name))
u0 = ElapsedMilliseconds() - u0

SortStructuredList(p0(), #PB_Sort_Ascending, OffsetOf(Person\Idx), TypeOf(Person\Idx))
u1 = ElapsedMilliseconds()
SortRecords_110(p0(), @ ComparePersons_w())
u1 = ElapsedMilliseconds() - u1

SortStructuredList(p0(), #PB_Sort_Ascending, OffsetOf(Person\Idx), TypeOf(Person\Idx))
u2 = ElapsedMilliseconds()
SortRecords_120(p0(), @ ComparePersons_w())
u2 = ElapsedMilliseconds() - u2

SortStructuredList(p0(), #PB_Sort_Ascending, OffsetOf(Person\Idx), TypeOf(Person\Idx))
CS::SetInsertionSortMaxSize(40)
u3 = ElapsedMilliseconds()
CS::SortListAny(p0(), @ ComparePersons())
u3 = ElapsedMilliseconds() - u3

; --------------------------------------------------------------------------

msg\$ + "-- Sorting structures" + #LF\$ +
"u0 = " + StrD(u0/1000,3) + " Sec. (built-in MergeSort)" + #LF\$ +
"u1 = " + StrD(u1/1000,3) + " Sec. (wilbert v1.10)" + #LF\$ +
"u2 = " + StrD(u2/1000,3) + " Sec. (wilbert v1.20)" + #LF\$ +
"u3 = " + StrD(u3/1000,3) + " Sec. (Little John)"

MessageRequester("Duration", msg\$)

_________________
Please excuse my flawed English. My native language is PureBasic.
Search
RSBasic's backups

Last edited by Little John on Mon Mar 04, 2019 5:25 pm, edited 2 times in total.

Top

 Post subject: Re: Non-recursive custom sort for Linked ListsPosted: Sun Mar 03, 2019 4:41 pm
 PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3609
Location: Netherlands
Little John wrote:
Here is a speed comparison of PB's internal sort, your custom sort, and mine.
The speed of your custom sort is impressive!

Thanks for testing

One reason it's fast is because of the non-recursive pointer based approach I used but I believe in general my code also does less comparisons which also makes a difference.
I can still improve the speed of my sort routine by converting the merge loop to ASM but I don't know if that's desirable; not everybody likes ASM.

_________________
macOS 10.15 Catalina, PB 5.71 x64

Top

 Post subject: Re: Non-recursive custom sort for Linked ListsPosted: Sun Mar 03, 2019 5:56 pm
 Addict

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3845
Location: Berlin, Germany
wilbert wrote:
I can still improve the speed of my sort routine by converting the merge loop to ASM but I don't know if that's desirable; not everybody likes ASM.

I've read in some textbooks and on the internet, that non-recursive bottom up MergeSort is the algorithm of choice for sorting Linked Lists. But most sources that I found only provide example code for recursive top down MergeSort. So at least for the PureBasic community, your code as it is is very valuable for educational purposes. If significant parts of the code will be written in ASM, it will not be understandable anymore for many people who want to learn how to write a fast bottom up MergeSort of Linked Lists.

So my personal vote is: If you are going to change parts of the code to ASM, please also leave the "pure PureBasic" code on the forum.

_________________
Please excuse my flawed English. My native language is PureBasic.
Search
RSBasic's backups

Top

 Post subject: Re: Non-recursive custom sort for Linked ListsPosted: Sun Mar 03, 2019 6:33 pm
 PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3609
Location: Netherlands
Little John wrote:
So my personal vote is: If you are going to change parts of the code to ASM, please also leave the "pure PureBasic" code on the forum.

In that case I'll leave it PB code only

If it's for educational purposes, it might be worth mentioning that I'm using a modified insertion sort.
Normally for each unsorted item you scan from the bottom of the sorted items up until you find the place to insert the unsorted item.
What I changed is that instead of starting at the bottom, I'm starting with the previous inserted item.
By doing so, you can tell a few things ...
If the unsorted item has an equal value as the previous inserted item, it should be placed directly after the previous inserted item.
If the unsorted item has to be inserted after the previous inserted item, it starts scanning from the bottom up like a normal insertion sort and it took one extra compare.
If the unsorted item has to be inserted before the previous inserted item, it scans from that previous inserted item up instead of from the bottom and therefore can skip items.
From the tests I did, this approach in most cases requires less items to compare against to find the right position to insert the unsorted item.

While doing the insertion sort, I'm also keeping track of the direction the 'unsorted' items were in.
[2,2,2,2,2,2,2,2] => No direction; all items have equal values
[1,2,3,3,3,7,8,9] => Non-descending; each next item has an equal or higher value as the previous one
[8,7,6,6,5,5,4,3] => Non-ascending; each next item has an equal or lower value as the previous one
[1,5,3,7,4,5,3,5] => Mixed; a really unsorted source of items
This detected direction I'm using for the merge procedure to decide if it should check if the entire list can be placed before or after the list it is merged with.

_________________
macOS 10.15 Catalina, PB 5.71 x64

Top

 Post subject: Re: Non-recursive custom sort for Linked ListsPosted: Sun Mar 03, 2019 11:32 pm
 Addict

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3845
Location: Berlin, Germany
Many thanks for the instructive explanations!

_________________
Please excuse my flawed English. My native language is PureBasic.
Search
RSBasic's backups

Top

 Post subject: Re: Non-recursive custom sort for Linked ListsPosted: Mon Mar 04, 2019 10:05 am
 PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3609
Location: Netherlands
@Little John,
The string compare procedure you used for my sort procedure isn't correct. It doesn't return -1, 0 or 1.
The easiest way is
Code:
Procedure.i CompareS_w (*a.String, *b.String)
; -- custom comparison function for sorting *ascending*
; in : *a, *b: pointers to strings to be compared
; out: return value: -1 / 0 / 1

ProcedureReturn CompareMemoryString(@*a\s, @*b\s)
EndProcedure

I found a way to simplify the merge procedure by swapping lists. It also results in a speed improvement.
It seems to function fine but I would appreciate it if you also verify if it sorts properly before I change the code in the original post.

Code:
DeclareModule SortLinkedList

; v 1.20  March 4, 2019

; Procedure Compare(*p1, *p2)
; <0 The element pointed to by *p1 goes before the element pointed to by *p2
;  0 The element pointed to by *p1 is equivalent to the element pointed to by *p2
; >0 The element pointed to by *p1 goes after the element pointed to by *p2

Declare _SortLinkedList_ (*LinkedList, *Compare, First=0, Last=-1)

Declare SortLinkedListD (List LinkedList.d(), *Compare, First=0, Last=-1)
Declare SortLinkedListI (List LinkedList.i(), *Compare, First=0, Last=-1)
Declare SortLinkedListS (List LinkedList.s(), *Compare, First=0, Last=-1)

EndDeclareModule

Module SortLinkedList

DisableDebugger
EnableExplicit

;- >> Structures <<

Structure PB_ListHeader
*Next.PB_ListHeader
*Previous.PB_ListHeader
Element.i[0]
EndStructure

Structure PB_List
*First.PB_ListHeader
*Last.PB_ListHeader
*Current.PB_ListHeader
*PtrCurrentVariable.Integer
NBElements.i
Index.i
*StructureMap
*Allocator
*PositionStack
*Object
ElementSize.i
ElementType.l
IsIndexInvalid.b
IsDynamic.b
IsDynamicObject.b
EndStructure

;- >> Prototypes <<

Prototype.i ProtoCompare (*p1, *p2)
Prototype Proto_SortLinkedListD (List LinkedList.d(), *Compare, First=0, Last=-1)
Prototype Proto_SortLinkedListI (List LinkedList.i(), *Compare, First=0, Last=-1)
Prototype Proto_SortLinkedListS (List LinkedList.s(), *Compare, First=0, Last=-1)

;- >> Procedures <<

Procedure _SortLinkedList_ (*LinkedList.PB_List, *Compare.ProtoCompare, First=0, Last=-1)
Protected Dim *ListHead(31)
Protected Dim *ListTail(31)
Protected.PB_ListHeader *EqualItems, *List, *List1, *List2, *Next, *P, *Stop, *Tail, *Tail1, *Tail2
Protected.i Check, Count, Direction, Fractional, FractionalCount, i, ListSize0, NumItems, NumLists

; Check parameters and return if there is nothing to sort
If *LinkedList And *Compare And *LinkedList\NBElements
If First < 0 : First = 0 : EndIf
If Last < 0 Or Last >= *LinkedList\NBElements
Last = *LinkedList\NBElements - 1
EndIf
NumItems = Last - First + 1
If NumItems <= 1
ProcedureReturn
EndIf
Else
ProcedureReturn
EndIf

; Invalidate the current index value
*LinkedList\IsIndexInvalid = #True

; Seek the first element to sort
If First << 1 < *LinkedList\NBElements
; Seek element starting from beginning
i = First
*List = *LinkedList\First
While i
*List = *List\Next
i - 1
Wend
Else
; Seek element starting from end
i = *LinkedList\NBElements - 1 - First
*List = *LinkedList\Last
While i
*List = *List\Previous
i - 1
Wend
EndIf

; Store pointer to previous element
*P = *List\Previous

; Calculate the initial list size so that
; the number of lists is a power of two
ListSize0 = NumItems >> 3
For i = 0 To 5
ListSize0 | ListSize0 >> (1 << i)
Next
NumLists = ListSize0 + 1
ListSize0 = NumItems / NumLists
Fractional = NumItems - NumLists * ListSize0

;- >> Sort <<
While NumItems

;- >> Build list using insertion sort <<
*Next = *List\Next
*Tail = *List
*List\Next = #Null
*List\Previous = #Null
*List1 = *List
*EqualItems = #Null
Direction = 0

Count = ListSize0
FractionalCount + Fractional
If FractionalCount >= NumLists
FractionalCount - NumLists
Count + 1
EndIf
NumItems - Count

While Count > 1
*List2 = *Next
*Next = *List2\Next

; Compare against previous insertion point
i = *Compare(@*List1\Element, @*List2\Element)
If i = 0
; No search; insert directly after previous insertion point
If *EqualItems = #Null
*EqualItems = *List1
EndIf
*Stop = *List1
Else
If i > 0
; Search back from previous insertion point
If *EqualItems
*List1 = *EqualItems
EndIf
*Stop = #Null
*List1 = *List1\Previous
If Direction And Direction <> -1
Direction = -2
Else
Direction = -1
EndIf
Else
; Search back from tail
*Stop = *List1
*List1 = *Tail
If Direction And Direction <> 1
Direction = -2
Else
Direction = 1
EndIf
EndIf
*EqualItems = #Null
EndIf
; Backward search
While *List1 <> *Stop And *Compare(@*List1\Element, @*List2\Element) > 0
*List1 = *List1\Previous
Wend
; Insert
If *List1
; Insert *List2 after *List1
*List2\Next = *List1\Next
*List2\Previous = *List1
If *List2\Next
*List2\Next\Previous = *List2
Else
*Tail = *List2
EndIf
*List1\Next = *List2
Else
; Insert *List2 before *List
*List2\Next = *List
*List2\Previous = #Null
*List\Previous = *List2
*List = *List2
EndIf
*List1 = *List2

Count - 1
Wend

; Merge with other list(s)
For i = 0 To 31
If *ListHead(i)
If *List
*List1 = *ListHead(i)
*Tail1 = *ListTail(i)
*List2 = *List
*Tail2 = *Tail

;- >> Merge List1 and List2 <<

If Direction = -1 And *Compare(@*List1\Element, @*Tail2\Element) > 0
; Entire List1 goes after List2
*Tail2\Next = *List1
*List1\Previous = *Tail2
*List = *List2
*Tail = *Tail1
ElseIf Direction >= 0 And *Compare(@*Tail1\Element, @*List2\Element) <= 0
; Entire List2 goes after List1
*Tail1\Next = *List2
*List2\Previous = *Tail1
*List = *List1
*Tail = *Tail2
Else
Direction = -2
; Merge List1 and List2 element by element

Check = 0
If *Compare(@*List1\Element, @*List2\Element) > 0
Swap *List1, *List2
Check = ~Check
EndIf
*List = *List1

Repeat
Repeat
*List1 = *List1\Next
Until *List1 = 0 Or *Compare(@*List1\Element, @*List2\Element) > Check

If *List1
; Switch lists
*List2\Previous = *List1\Previous
*List1\Previous\Next = *List2
Swap *List1, *List2
Check = ~Check
Else
; Append remaining items
If Check
Swap *Tail1, *Tail2
EndIf
*Tail1\Next = *List2
*List2\Previous = *Tail1
*Tail = *Tail2
Break
EndIf
ForEver

EndIf

;- >> End of merge <<

Else
*List = *ListHead(i)
*Tail = *ListTail(i)
EndIf
*ListHead(i) = #Null
ElseIf NumItems
Break
EndIf
Next

If NumItems
If i > 31 : i = 31 : EndIf
*ListHead(i) = *List
*ListTail(i) = *Tail
*List = *Next
EndIf

Wend

; Update *First and *Last when needed
If First = 0
*LinkedList\First = *List
Else
*P\Next = *List
*List\Previous = *P
EndIf
If Last = *LinkedList\NBElements - 1
*LinkedList\Last = *Tail
Else
*Tail\Next = *Next
*Next\Previous = *Tail
EndIf

EndProcedure

Procedure SortLinkedListD (List LinkedList.d(), *Compare, First=0, Last=-1)
Protected SortLinkedList.Proto_SortLinkedListD = @_SortLinkedList_()
SortLinkedList(LinkedList(), *Compare, First, Last)
EndProcedure

Procedure SortLinkedListI (List LinkedList.i(), *Compare, First=0, Last=-1)
Protected SortLinkedList.Proto_SortLinkedListI = @_SortLinkedList_()
SortLinkedList(LinkedList(), *Compare, First, Last)
EndProcedure

Procedure SortLinkedListS (List LinkedList.s(), *Compare, First=0, Last=-1)
Protected SortLinkedList.Proto_SortLinkedListS = @_SortLinkedList_()
SortLinkedList(LinkedList(), *Compare, First, Last)
EndProcedure

EndModule

_________________
macOS 10.15 Catalina, PB 5.71 x64

Top

 Post subject: Re: Non-recursive custom sort for Linked ListsPosted: Mon Mar 04, 2019 5:48 pm
 Addict

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3845
Location: Berlin, Germany
wilbert wrote:
@Little John,
The string compare procedure you used for my sort procedure isn't correct. It doesn't return -1, 0 or 1.
Yes, I used wrong comparison code for the string sorting in the speed test. Sorry!
The other compare procedures were correct, but unnecessary complicated.

wilbert wrote:
The easiest way is
Code:
Procedure.i CompareS_w (*a.String, *b.String)
; -- custom comparison function for sorting *ascending*
; in : *a, *b: pointers to strings to be compared
; out: return value: -1 / 0 / 1

ProcedureReturn CompareMemoryString(@*a\s, @*b\s)
EndProcedure

I've changed both the validation test and the speed test above, and this is now always used.
I hope both tests are correct now.

I didn't encounter any problems with your new code.
In the validation test, the 'Person' structures now are first sorted by name, and then by age. Since there are several groups of persons with the same age, and the results of PB's SortStructuredList() -- which does stable sorting -- and of your code are identical, this confirms that your sort is stable, too.

These are the results of my new speed test here on Windows 10:
Quote:
-- Sorting strings
t0 = 0.352 Sec. (built-in MergeSort)
t1 = 0.592 Sec. (wilbert v1.10)
t2 = 0.563 Sec. (wilbert v1.20)
t3 = 0.810 Sec. (Little John)

-- Sorting structures
u0 = 0.424 Sec. (built-in MergeSort)
u1 = 0.638 Sec. (wilbert v1.10)
u2 = 0.547 Sec. (wilbert v1.20)
u3 = 1.202 Sec. (Little John)

_________________
Please excuse my flawed English. My native language is PureBasic.
Search
RSBasic's backups

Top

 Post subject: Re: Non-recursive custom sort for Linked ListsPosted: Mon Mar 04, 2019 7:51 pm
 PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3609
Location: Netherlands
Little John wrote:
I've changed both the validation test and the speed test above, and this is now always used.
I hope both tests are correct now.

I didn't encounter any problems with your new code.
In the validation test, the 'Person' structures now are first sorted by name, and then by age. Since there are several groups of persons with the same age, and the results of PB's SortStructuredList() -- which does stable sorting -- and of your code are identical, this confirms that your sort is stable, too.

These are the results of my new speed test here on Windows 10:

Thank you very much !

_________________
macOS 10.15 Catalina, PB 5.71 x64

Top

 Display posts from previous: All posts1 day7 days2 weeks1 month3 months6 months1 year Sort by AuthorPost timeSubject AscendingDescending
 Page 1 of 1 [ 15 posts ]

 All times are UTC + 1 hour

#### Who is online

Users browsing this forum: No registered users and 15 guests

 You cannot post new topics in this forumYou cannot reply to topics in this forumYou cannot edit your posts in this forumYou cannot delete your posts in this forum

Search for:
 Jump to:  Select a forum ------------------ PureBasic    Coding Questions    Game Programming    3D Programming    Assembly Programming    The PureBasic Editor    The PureBasic Form Designer    General Discussion    Feature Requests and Wishlists    Tricks 'n' Tips Bug Reports    Bugs - Windows    Bugs - Linux    Bugs - Mac OSX    Bugs - IDE    Bugs - Documentation OS Specific    AmigaOS    Linux    Windows    Mac OSX Miscellaneous    Announcement    Off Topic Showcase    Applications - Feedback and Discussion    PureFORM & JaPBe    TailBite

Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye