It is currently Fri Dec 06, 2019 9:21 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 15 posts ] 
Author Message
 Post subject: Non-recursive custom sort for Linked Lists
PostPosted: Mon Feb 25, 2019 10:09 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3542
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
 Profile  
Reply with quote  
 Post subject: Re: Non-recursive pointer based sort for Linked Lists
PostPosted: Mon Feb 25, 2019 10:10 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3542
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
 Profile  
Reply with quote  
 Post subject: Re: Non-recursive custom sort for Linked Lists
PostPosted: Wed Feb 27, 2019 4:34 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3715
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
 Profile  
Reply with quote  
 Post subject: Re: Non-recursive custom sort for Linked Lists
PostPosted: Wed Feb 27, 2019 6:14 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3542
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
 Profile  
Reply with quote  
 Post subject: Re: Non-recursive custom sort for Linked Lists
PostPosted: Thu Feb 28, 2019 12:57 pm 
Offline
Addict
Addict
User avatar

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

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


Top
 Profile  
Reply with quote  
 Post subject: Re: Non-recursive custom sort for Linked Lists
PostPosted: Sat Mar 02, 2019 12:36 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3542
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
 Profile  
Reply with quote  
 Post subject: Re: Non-recursive custom sort for Linked Lists
PostPosted: Sun Mar 03, 2019 3:45 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3715
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. :D

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
 Profile  
Reply with quote  
 Post subject: Re: Non-recursive custom sort for Linked Lists
PostPosted: Sun Mar 03, 2019 3:54 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3715
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
 Profile  
Reply with quote  
 Post subject: Re: Non-recursive custom sort for Linked Lists
PostPosted: Sun Mar 03, 2019 4:41 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3542
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
 Profile  
Reply with quote  
 Post subject: Re: Non-recursive custom sort for Linked Lists
PostPosted: Sun Mar 03, 2019 5:56 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3715
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
 Profile  
Reply with quote  
 Post subject: Re: Non-recursive custom sort for Linked Lists
PostPosted: Sun Mar 03, 2019 6:33 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3542
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 :wink:

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
 Profile  
Reply with quote  
 Post subject: Re: Non-recursive custom sort for Linked Lists
PostPosted: Sun Mar 03, 2019 11:32 pm 
Offline
Addict
Addict
User avatar

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

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


Top
 Profile  
Reply with quote  
 Post subject: Re: Non-recursive custom sort for Linked Lists
PostPosted: Mon Mar 04, 2019 10:05 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3542
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
 Profile  
Reply with quote  
 Post subject: Re: Non-recursive custom sort for Linked Lists
PostPosted: Mon Mar 04, 2019 5:48 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3715
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
 Profile  
Reply with quote  
 Post subject: Re: Non-recursive custom sort for Linked Lists
PostPosted: Mon Mar 04, 2019 7:51 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3542
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
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 15 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 9 guests


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

Search for:
Jump to:  

 


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