PureBasic Forums - English

Posted: **Mon Feb 25, 2019 10:09 am**

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
Update October 4, 2023 : Fix for C backend

Code: Select all

DeclareModule SortLinkedList
  
  ; v 1.11  October 4, 2023
  
  ; 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
    
    ; Fix for C backend
    CompilerIf Defined(PB_Backend_C, #PB_Constant) And #PB_Compiler_Backend = #PB_Backend_C
      If *LinkedList : *LinkedList = *LinkedList\First : EndIf
    CompilerEndIf
    
    ; 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

Posted: **Mon Feb 25, 2019 10:10 am**

Example ...

Code: Select all

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

Posted: **Wed Feb 27, 2019 4:34 pm**

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.

Posted: **Wed Feb 27, 2019 6:14 pm**

Little John wrote:I'll take a closer look at it as soon as I have some time for doing so.

I appreciate that

Posted: **Thu Feb 28, 2019 12:57 pm**

Works good here
Thanks for sharing

Posted: **Sat Mar 02, 2019 12:36 pm**

I updated my code.
It should (hopefully) perform a bit better now on lists that are mostly in reverse order.

Posted: **Sun Mar 03, 2019 3:45 pm**

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: Select all

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)

Posted: **Sun Mar 03, 2019 3:54 pm**

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: Select all

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$)

Posted: **Sun Mar 03, 2019 4:41 pm**

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.

Posted: **Sun Mar 03, 2019 5:56 pm**

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.

Posted: **Sun Mar 03, 2019 6:33 pm**

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.

Posted: **Sun Mar 03, 2019 11:32 pm**

Many thanks for the instructive explanations!

Posted: **Mon Mar 04, 2019 10:05 am**

@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: Select all

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: Select all

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

Posted: **Mon Mar 04, 2019 5:48 pm**

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: Select all

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:

-- 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)

Posted: **Mon Mar 04, 2019 7:51 pm**

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 !

PureBasic Forums - English

Non-recursive custom sort for Linked Lists

Non-recursive custom sort for Linked Lists

Re: Non-recursive pointer based sort for Linked Lists

Re: Non-recursive custom sort for Linked Lists

Re: Non-recursive custom sort for Linked Lists

Re: Non-recursive custom sort for Linked Lists

Re: Non-recursive custom sort for Linked Lists

Re: Non-recursive custom sort for Linked Lists

Re: Non-recursive custom sort for Linked Lists

Re: Non-recursive custom sort for Linked Lists

Re: Non-recursive custom sort for Linked Lists

Re: Non-recursive custom sort for Linked Lists

Re: Non-recursive custom sort for Linked Lists

Re: Non-recursive custom sort for Linked Lists

Re: Non-recursive custom sort for Linked Lists

Re: Non-recursive custom sort for Linked Lists