Yuki and Olli,
thank you very much for your immense cooperation and the effort you have made.
I'll have to wait until tomorrow to take a closer look at everything. In any case, it's really great that you (Yuki) have implemented your V4 and V5 solutions as a procedure that can be directly integrated into the test framework. Great.
I will also convert my testframework here to PrintN() outputs to be able to do the measurements without the debugger.
Then tomorrow I will look at the V4 and V5 solutions in detail. I want to understand the solutions, not just copy them. This is also my personal requirement.
Thank you both for your efforts. I will report, how it goes on with my module and whether I possibly entangle myself again in curious sorting results. LOL
Edit:
I have now rebuilt the test framework and have also rearranged the init() procedure to use the same gadgets and references model where my V3 algorithm failed within the "WinHandler module".
Yuki, but in doing so I noticed that your V4 does the sorting fine, but V5 displays a "DebuggerError("Your hierarchy has held cycles!")" which, in my opinion, is not present.
Here again my testframewiork, maybe I missed something in the hurry.... I'm about to leave my office now, it's already way too late to be at work
I will do everything else tomorrow.
See you... and thanks again!
(the code is corrected in the meantime, see Edit2 below).
Code: Select all
EnableExplicit
Structure MyStruct
Entry.s
RefEntry.s
Sort.i
EndStructure
Global NewList StructList.MyStruct()
Global NewMap StructMap.MyStruct()
Define i, StartTime, Duration
OpenConsole()
ConsoleTitle ("Sorting")
EnableGraphicalConsole(1)
; -----------------------------------
; Procedure for high resolution time measurement, thanks go to Axolotl
; https://www.purebasic.fr/english/viewtopic.php?p=589086#p589086
Procedure.i ElapsedMicroseconds()
Static frequency.q
Protected count.q
If frequency = 0
If QueryPerformanceFrequency_(@frequency)
; frequency / 10000 ; .. divide frequency by 10000 for tenths of a millisecond
; frequency / 1000 ;:: in milli seconds
; frequency / 1000 ;:: in micro seconds
frequency / 1000000 ;:: in micro seconds
EndIf
EndIf
If QueryPerformanceCounter_(@count)
ProcedureReturn count / frequency
Else
ProcedureReturn 0
EndIf
EndProcedure
; The sorting procedures
Procedure Sortlist_V1()
Protected i, j, SearchStart = 0, SearchEnd = ListSize(StructList()) - 1, *Entry
Protected.s RefEntry
For i = SearchStart To SearchEnd - 1
SelectElement(StructList(), i)
If StructList()\RefEntry <> ""
*Entry = @StructList()
RefEntry = StructList()\RefEntry
For j = i + 1 To SearchEnd
SelectElement(StructList(), j)
If StructList()\Entry = RefEntry
If StructList()\RefEntry <> ""
i - 1
EndIf
MoveElement(StructList(), #PB_List_Before, *Entry)
Break
EndIf
Next
EndIf
Next
EndProcedure
Procedure Sortlist_V2()
Protected i, j, SkipEntries, SearchStart = 0, SearchEnd = ListSize(StructList()) - 1, *Entry
Protected.s RefEntry
For i = SearchStart To SearchEnd - 1
SelectElement(StructList(), i)
If StructList()\RefEntry <> ""
*Entry = @StructList()
RefEntry = StructList()\RefEntry
For j = i + 1 To SearchEnd
SelectElement(StructList(), j)
If StructList()\Entry = RefEntry
If StructList()\RefEntry <> ""
i - 1
SkipEntries + 1
Else
i + SkipEntries
SkipEntries = 1
EndIf
MoveElement(StructList(), #PB_List_Before, *Entry)
Break
EndIf
Next
EndIf
Next
EndProcedure
Procedure SortList_V3()
Protected Sortvalue = 0
#Blocksize = 1000
; We work through the list from beginning to end using the following logic:
; 1) We sort the list in ascending order by RefEntry, so that all entries without RefEntry are at the beginning
; 2) We go through the list once from beginning to end to get the sorted element names
; These represent the keys of the identical map. In this loop, only the entries of the map are processed.
; a) If the map entry does *not* reference any other entry and field sort = 0:
; - The map entry gets in the field Sort = Sortvalue
; - Sortvalue = Sortvalue + #Blocksize (1000)
; b) If the map entry *does* reference any other entry:
; - If the referenced entry in the map has no Sortvalue yet:
; - The referenced map entry gets in the field Sort = Sortvalue
; - Sortvalue = Sortvalue + #Blocksize (1000)
; - After this:
; - If the map entry referencing the other element does not yet have a Sortvalue:
; - The map entry gets in the field Sort = Sortvalue
; - Sortvalue = Sortvalue + #Blocksize (1000)
; c) If the referenced(!) entry in the map already has a sortvalue:
; - The entry that references it gets the Sortvalue + 1 from the referenced entry
; - Sortvalue = Sortvalue + #Blocksize (1000)
; 3) We sort the list in ascending order by the field sort
; 1)
SortStructuredList(StructList(), #PB_Sort_Ascending, OffsetOf(MyStruct\RefEntry), TypeOf(MyStruct\RefEntry))
With StructList()
; 2)
ForEach StructList()
; 2b)
If \RefEntry <> ""
If StructMap(\RefEntry)\Sort = 0
StructMap(\RefEntry)\Sort = Sortvalue
Sortvalue + #Blocksize
If StructMap(\Entry)\Sort = 0
StructMap(\Entry)\Sort = Sortvalue
Sortvalue + #Blocksize
EndIf
; 2c)
Else
StructMap(\Entry)\Sort = StructMap(\RefEntry)\Sort + 1
Sortvalue + #Blocksize
EndIf
; 2a)
ElseIf StructMap(\Entry)\Sort = 0
StructMap(\Entry)\Sort = Sortvalue
Sortvalue + #Blocksize
EndIf
Next
ForEach StructList()
\Sort = StructMap(\Entry)\Sort
Next
EndWith
; 3)
SortStructuredList(StructList(), #PB_Sort_Ascending, OffsetOf(MyStruct\Sort), TypeOf(MyStruct\Sort))
EndProcedure
Procedure SortList_V4()
Protected numAssignedInCurrentPass
Protected *parent.MyStruct
Static NewMap *handledOrderMap.MyStruct(4096)
ClearMap(*handledOrderMap())
; Find all elements on the first layer of tree (without parent/ref) and store them in
; our known-order map while assigning depth (\Sort) 1.
; All other elements will be assigned depth (\Sort) 0.
ForEach StructList()
If StructList()\RefEntry = ""
StructList()\Sort = 1
*handledOrderMap(StructList()\Entry) = StructList()
Else
StructList()\Sort = 0
EndIf
Next
; Repeatedly scan the list searching for elements yet-to-be assigned a non-zero depth (\Sort)
; value, while assigning such once if we've handled their parent/ref.
; The scanning process stops whenever we are no longer able to assign a single depth value
; in a single pass. This should only happen when complete OR running into cycles.
Repeat
numAssignedInCurrentPass = 0
ForEach StructList()
If Not StructList()\Sort
*parent = *handledOrderMap(StructList()\RefEntry)
If *parent
StructList()\Sort = *parent\Sort + 1
*handledOrderMap(StructList()\Entry) = StructList()
numAssignedInCurrentPass + 1
EndIf
EndIf
Next
Until Not numAssignedInCurrentPass
SortStructuredList(StructList(), #PB_Sort_Ascending, OffsetOf(MyStruct\Sort), TypeOf(MyStruct\Sort))
EndProcedure
Procedure SortList_V5()
Static NewMap seenOrderMap.i(2048)
Static Dim *pendingEntries.MyStruct(0)
Protected *currentEntry.MyStruct
Protected pendingCount, parentOrder, x, xLim
Protected entryCount = ListSize(StructList())
; Reset known orders from a prior sort operation
ClearMap(seenOrderMap())
; Resize pending array to accommodate entries. Could make this more dynamic and/or a factor
; of the entry count to reduce reallocs.
If ArraySize(*pendingEntries()) < entryCount
ReDim *pendingEntries(entryCount)
EndIf
; Iterate over elements in order to assign those without a parent/ref a sort order which
; clearly represents their being on effectively the first layer of our tree.
; All other elements will be stored in a pending array in order to be later grouped under
; known elements.
ForEach StructList()
If StructList()\RefEntry = ""
StructList()\Sort = 1
seenOrderMap(StructList()\Entry) = 1
Else
*pendingEntries(pendingCount) = StructList()
pendingCount + 1
EndIf
Next
; Continue scanning elements so long as we've some which haven't been associated with a
; proper sort order.
While pendingCount
; Store number of elements to iterate over before resetting pending count.
xLim = pendingCount - 1
pendingCount = 0
For x = 0 To xLim
*currentEntry = *pendingEntries(x)
parentOrder = seenOrderMap(*currentEntry\RefEntry)
If parentOrder
; Element has at last been assigned an order.
*currentEntry\Sort = parentOrder + 1
seenOrderMap(*currentEntry\Entry) = parentOrder + 1
Else
; Element must go back to the pending pool.
*pendingEntries(pendingCount) = *currentEntry
pendingCount + 1
EndIf
Next
; In cases where the pending count is non-zero and hasn't changed, we've certainly a
; cycle present. Trigger a debugger error and bail if not debugging.
If pendingCount = xLim + 1
DebuggerError("Your hierarchy has held cycles!")
Break
EndIf
Wend
SortStructuredList(StructList(), #PB_Sort_Ascending, OffsetOf(MyStruct\Sort), TypeOf(MyStruct\Sort))
EndProcedure
; -----------------------------------
; Initializing the list and map
Procedure Init()
Protected i
ClearList(StructList())
ClearMap(StructMap())
; We create a list of n entries to get enough runtime for a time measurement.
For i = 1 To 1 Step 1
AddElement(StructList()) : StructList()\Entry = "button nothing_" + Str(i)
AddElement(StructList()) : StructList()\Entry = "test button_" + Str(i) : StructList()\RefEntry = "button settings_" + Str(i)
AddElement(StructList()) : StructList()\Entry = "test2 button_" + Str(i) : StructList()\RefEntry = "editor_" + Str(i)
AddElement(StructList()) : StructList()\Entry = "button settings_" + Str(i)
AddElement(StructList()) : StructList()\Entry = "editor_" + Str(i)
AddElement(StructList()) : StructList()\Entry = "button info_" + Str(i) : StructList()\RefEntry = "editor_" + Str(i)
AddElement(StructList()) : StructList()\Entry = "button set data_" + Str(i) : StructList()\RefEntry = "button info_" + Str(i)
AddElement(StructList()) : StructList()\Entry = "button clr data_" + Str(i) : StructList()\RefEntry = "button set data_" + Str(i)
AddElement(StructList()) : StructList()\Entry = "button show data_" + Str(i) : StructList()\RefEntry = "button clr data_" + Str(i)
AddElement(StructList()) : StructList()\Entry = "button show gad_" + Str(i) : StructList()\RefEntry = "button show data_" + Str(i)
AddElement(StructList()) : StructList()\Entry = "button show ini_" + Str(i) : StructList()\RefEntry = "button show gad_" + Str(i)
AddElement(StructList()) : StructList()\Entry = "button exit_" + Str(i)
Next i
; Now we create a map with the same content as the list
ForEach StructList()
StructMap(StructList()\Entry)\Entry =StructList()\Entry
StructMap(StructList()\Entry)\RefEntry =StructList()\RefEntry
Next
; All steps up to here can be realized in my use case by the code area responsible for registering a gadget in my module.
; Therefore this code part must not be included in the time measurement.
EndProcedure
; -----------------------------------
Procedure PrintList(Title.s = "", MaxEntries.i = 32)
Protected.i i
PrintN(Title)
PrintN(".═════+════════════════════════+════════════════════════+══════════.")
PrintN("| # | Name | Ref | Sort |")
PrintN("|-----|------------------------|------------------------|----------|")
ForEach StructList()
If i < MaxEntries
PrintN("|" + RSet(Str(i) + " ", 5) + "| " + LSet(StructList()\Entry, 23) + "| " + LSet(StructList()\RefEntry, 23) + "| " + LSet(Str(StructList()\Sort), 9) + "|")
i + 1
EndIf
Next
EndProcedure
; -----------------------------------
; START
Init()
PrintList("UNSORTED LIST")
PrintN("")
If 1=1
Init()
StartTime = ElapsedMicroseconds()
SortList_V1()
Duration = ElapsedMicroseconds() - StartTime
PrintN(""): PrintN("")
PrintList("V1 Algorithm: " + Str(Duration) + " microseconds.")
EndIf
If 1=1
Init()
StartTime = ElapsedMicroseconds()
SortList_V2()
Duration = ElapsedMicroseconds() - StartTime
PrintN(""): PrintN("")
PrintList("V2 Algorithm: " + Str(Duration) + " microseconds.")
EndIf
If 1=1
Init()
StartTime = ElapsedMicroseconds()
SortList_V3()
Duration = ElapsedMicroseconds() - StartTime
PrintN(""): PrintN("")
PrintList("V3 Algorithm: " + Str(Duration) + " microseconds.")
EndIf
If 1=1
Init()
StartTime = ElapsedMicroseconds()
SortList_V4()
Duration = ElapsedMicroseconds() - StartTime
PrintN(""): PrintN("")
PrintList("V4 Algorithm: " + Str(Duration) + " microseconds.")
EndIf
If 1=1
Init()
StartTime = ElapsedMicroseconds()
SortList_V5()
Duration = ElapsedMicroseconds() - StartTime
PrintN(""): PrintN("")
PrintList("V5 Algorithm: " + Str(Duration) + " microseconds.")
EndIf
PrintN("")
Print("Press any key to exit")
Input()
Code: Select all
UNSORTED LIST
.═════+════════════════════════+════════════════════════+══════════.
| # | Name | Ref | Sort |
|-----|------------------------|------------------------|----------|
| 0 | button nothing_1 | | 0 |
| 1 | test button_1 | button settings_1 | 0 |
| 2 | test2 button_1 | editor_1 | 0 |
| 3 | button settings_1 | | 0 |
| 4 | editor_1 | | 0 |
| 5 | button info_1 | editor_1 | 0 |
| 6 | button set data_1 | button info_1 | 0 |
| 7 | button clr data_1 | button set data_1 | 0 |
| 8 | button show data_1 | button clr data_1 | 0 |
| 9 | button show gad_1 | button show data_1 | 0 |
| 10 | button show ini_1 | button show gad_1 | 0 |
| 11 | button exit_1 | | 0 |
V1 Algorithm: 6 microseconds.
.═════+════════════════════════+════════════════════════+══════════.
| # | Name | Ref | Sort |
|-----|------------------------|------------------------|----------|
| 0 | button nothing_1 | | 0 |
| 1 | button settings_1 | | 0 |
| 2 | test button_1 | button settings_1 | 0 |
| 3 | editor_1 | | 0 |
| 4 | test2 button_1 | editor_1 | 0 |
| 5 | button info_1 | editor_1 | 0 |
| 6 | button set data_1 | button info_1 | 0 |
| 7 | button clr data_1 | button set data_1 | 0 |
| 8 | button show data_1 | button clr data_1 | 0 |
| 9 | button show gad_1 | button show data_1 | 0 |
| 10 | button show ini_1 | button show gad_1 | 0 |
| 11 | button exit_1 | | 0 |
V2 Algorithm: 4 microseconds.
.═════+════════════════════════+════════════════════════+══════════.
| # | Name | Ref | Sort |
|-----|------------------------|------------------------|----------|
| 0 | button nothing_1 | | 0 |
| 1 | button settings_1 | | 0 |
| 2 | test button_1 | button settings_1 | 0 |
| 3 | editor_1 | | 0 |
| 4 | test2 button_1 | editor_1 | 0 |
| 5 | button info_1 | editor_1 | 0 |
| 6 | button set data_1 | button info_1 | 0 |
| 7 | button clr data_1 | button set data_1 | 0 |
| 8 | button show data_1 | button clr data_1 | 0 |
| 9 | button show gad_1 | button show data_1 | 0 |
| 10 | button show ini_1 | button show gad_1 | 0 |
| 11 | button exit_1 | | 0 |
V3 Algorithm: 7 microseconds.
.═════+════════════════════════+════════════════════════+══════════.
| # | Name | Ref | Sort |
|-----|------------------------|------------------------|----------|
| 0 | button nothing_1 | | 0 |
| 1 | button settings_1 | | 1000 |
| 2 | test button_1 | button settings_1 | 1001 |
| 3 | editor_1 | | 2000 |
| 4 | test2 button_1 | editor_1 | 2001 |
| 5 | button info_1 | editor_1 | 2001 |
| 6 | button exit_1 | | 3000 |
| 7 | button show data_1 | button clr data_1 | 5000 |
| 8 | button show gad_1 | button show data_1 | 5001 |
| 9 | button show ini_1 | button show gad_1 | 5002 |
| 10 | button set data_1 | button info_1 | 7000 |
| 11 | button clr data_1 | button set data_1 | 7001 |
V4 Algorithm: 140 microseconds.
.═════+════════════════════════+════════════════════════+══════════.
| # | Name | Ref | Sort |
|-----|------------------------|------------------------|----------|
| 0 | button nothing_1 | | 1 |
| 1 | button settings_1 | | 1 |
| 2 | editor_1 | | 1 |
| 3 | button exit_1 | | 1 |
| 4 | test button_1 | button settings_1 | 2 |
| 5 | test2 button_1 | editor_1 | 2 |
| 6 | button info_1 | editor_1 | 2 |
| 7 | button set data_1 | button info_1 | 3 |
| 8 | button clr data_1 | button set data_1 | 4 |
| 9 | button show data_1 | button clr data_1 | 5 |
| 10 | button show gad_1 | button show data_1 | 6 |
| 11 | button show ini_1 | button show gad_1 | 7 |
V5 Algorithm: 12 microseconds.
.═════+════════════════════════+════════════════════════+══════════.
| # | Name | Ref | Sort |
|-----|------------------------|------------------------|----------|
| 0 | button nothing_1 | | 1 |
| 1 | button settings_1 | | 1 |
| 2 | editor_1 | | 1 |
| 3 | button exit_1 | | 1 |
| 4 | test button_1 | button settings_1 | 2 |
| 5 | test2 button_1 | editor_1 | 2 |
| 6 | button info_1 | editor_1 | 2 |
| 7 | button set data_1 | button info_1 | 3 |
| 8 | button clr data_1 | button set data_1 | 4 |
| 9 | button show data_1 | button clr data_1 | 5 |
| 10 | button show gad_1 | button show data_1 | 6 |
| 11 | button show ini_1 | button show gad_1 | 7 |
Press any key to exit
Edit2:
I have now fixed my error that I mentioned
here.
All sorting algorithms now work properly.
Yuki, I will adapt your last V5 version to my needs and then I can finally continue with the programming of the module. - Unfortunately I didn't get around to it the last days.