PureBasic sortiert LinkedList im Mergesort verfahren, Array aber im Quicksort verfahren.
(Mergesort hat den Vorteil, das es ein stabiles Sortierverfahren ist)
Da ich für ein Projekt aber auch bei Array das Mergesort Verfahren gebraucht habe möchte ich den Code hier mit euch teilen.
Gruß
Code: Alles auswählen
;******************
; MergeSort für Struktuierte Array mit multithreading
; 2017 ST4242
;
; *********
EnableExplicit
Structure SortString ; für Mergesort
s.s
EndStructure
;- array mergesort
Structure MergeSort_array_Mcpu
*liste ; first element
startleft.i
endright.i
typ.i ; pb_type
deep.i ; für multithread
size.i ;größe der Struktur
offset.i ; offset des element
EndStructure
Procedure MergeSort_Array_mpcu(*data.MergeSort_array_Mcpu)
; sortiert das Array nach Mergesort verfahren
;Mergesortvefahren, wir teilen die Menge in zwei Teile auf welche sortiert sein müssen
Protected thid,p1.MergeSort_array_Mcpu,p2.MergeSort_array_Mcpu
Protected Endleft,StartRight
Protected startleft=*data\startleft,EndRight=*Data\endright
Protected *mem,*ele.SortString,*ele1.SortString,bed
Endleft=(*data\startleft+ *data\endright)/2
StartRight=Endleft+1
If Endleft-startleft
CopyMemory(*data,@p1,SizeOf(MergeSort_array_Mcpu))
p1\startleft=startleft
p1\endright=Endleft
If p1\deep And endright-startright ; aufruf thread nur wenn rechter teile auch aufgerufen werden muß
p1\deep-1
thid=CreateThread(@MergeSort_Array_mpcu(),@p1)
EndIf
If Not thid:MergeSort_Array_mpcu(@p1):EndIf ; nicht mehr threaden oder thread starten nicht erfolgreich
EndIf
If endright-startright
CopyMemory(*data,@p2,SizeOf(MergeSort_array_Mcpu))
p2\startleft=StartRight
p2\endright=endright
MergeSort_Array_mpcu(@p2)
EndIf
If thid:WaitThread(thid):EndIf
*ele=*data\liste+Endleft* *data\size+ *data\offset
*ele1=*data\liste+StartRight* *data\size + *data\offset
Select *data\typ
Case #PB_Byte ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Byte (.b)
bed=Bool(PeekB(*ele)>PeekB(*ele1)) ; mit peek brauche ich keine zweite struktur
Case #PB_Word ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Word (.w)
bed=Bool(PeekW(*ele)>PeekW(*ele1))
Case #PB_Long ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Long (.l)
bed=Bool(PeekL(*ele)>PeekL(*ele1))
Case #PB_String ; Das Strukturfeld, nach dem sortiert werden soll, ist ein String (.s oder $), Fixed Strings werden nicht unterstützt.
bed=Bool( *ele\s>*ele1\s)
Case #PB_Float ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Float (.f)
bed=Bool(PeekF(*ele)>PeekF(*ele1))
Case #PB_Double ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Double (.d)
bed=Bool(PeekD(*ele)>PeekD(*ele1) )
Case #PB_Quad ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Quad (.q)
bed=Bool(PeekQ(*ele)>PeekQ(*ele1) )
Case #PB_Character; Das Strukturfeld, nach dem sortiert werden soll, ist ein Character (.c)
bed=Bool(PeekC(*ele)>PeekC(*ele1) )
Case #PB_Integer ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Integer (.i)
bed=Bool(PeekI(*ele)>PeekI(*ele1) )
Case #PB_Ascii ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Ascii-Zeichen (.a)
bed=Bool(PeekA(*ele)>PeekA(*ele1))
Case #PB_Unicode
bed=Bool(PeekU(*ele)>PeekU(*ele1))
EndSelect
If bed
*ele=*data\liste+startleft* *data\size+ *data\offset
*mem=AllocateMemory(*data\size )
While StartRight<=endright And startleft<=Endleft
Select *data\typ
Case #PB_Byte ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Byte (.b)
bed=Bool(PeekB(*ele)<=PeekB(*ele1)) ; mit peek brauche ich keine zweite struktur
Case #PB_Word ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Word (.w)
bed=Bool(PeekW(*ele)<=PeekW(*ele1))
Case #PB_Long ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Long (.l)
bed=Bool(PeekL(*ele)<=PeekL(*ele1))
Case #PB_String ; Das Strukturfeld, nach dem sortiert werden soll, ist ein String (.s oder $), Fixed Strings werden nicht unterstützt.
bed=Bool( *ele\s<=*ele1\s)
Case #PB_Float ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Float (.f)
bed=Bool(PeekF(*ele)<=PeekF(*ele1))
Case #PB_Double ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Double (.d)
bed=Bool(PeekD(*ele)<=PeekD(*ele1) )
Case #PB_Quad ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Quad (.q)
bed=Bool(PeekQ(*ele)<=PeekQ(*ele1) )
Case #PB_Character; Das Strukturfeld, nach dem sortiert werden soll, ist ein Character (.c)
bed=Bool(PeekC(*ele)<=PeekC(*ele1) )
Case #PB_Integer ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Integer (.i)
bed=Bool(PeekI(*ele)<=PeekI(*ele1) )
Case #PB_Ascii ; Das Strukturfeld, nach dem sortiert werden soll, ist ein Ascii-Zeichen (.a)
bed=Bool(PeekA(*ele)<=PeekA(*ele1) )
Case #PB_Unicode
bed=Bool(PeekU(*ele)<=PeekU(*ele1))
EndSelect
If Not(bed)
; Wert von Rechts nach links in die Liste und alle elemente müssten weiterrutschen
*ele1- *data\offset ; zurück auf das erste Element der Strucktur
*ele- *data\offset
CopyMemory(*ele1,*mem,*data\size ) ; wert sichern
MoveMemory(*ele,*ele+ *data\size ,*data\size *(StartRight-startleft)) ; dieser Vorgang kostet Zeit bei großen ARRAY's
CopyMemory(*mem,*ele,*data\size )
; ; wieder zurück auf das Element innerhalb der Struktur
*ele+ *Data\offset ; *data\size kommt unten
StartRight+1
Endleft+1
*ele1+ *Data\size + *Data\offset
EndIf
startleft+1 ; Element links muß immer erhöht entweder weil das element stimmt oder weil wir verschoben haben
*ele+ *Data\size
Wend
FreeMemory(*mem)
EndIf
EndProcedure
Procedure MergeSort_Array(*liste,offsetofelement,sizeofstructure,feldtype,first,last,singlethread=#False)
; Protected *mem
Protected p1.MergeSort_array_Mcpu
p1\typ=feldtype
p1\startleft=first
p1\endright=last
p1\liste=*liste
p1\size=sizeofstructure
p1\offset=offsetofelement
If last-first<10 Or singlethread
p1\deep=0; wir threaden nicht mehr da deep überschritten
Else
p1\deep=Sqr(CountCPUs())
EndIf
MergeSort_Array_mpcu(@p1)
EndProcedure
;- testprogramm
Structure test
x.l
y.w
t.s
EndStructure
Define anz,i,st,st1,mt,mt1,mts,mts1
anz=10000
Dim test.test(anz)
Dim testms.test(anz)
Dim testmss.test(anz)
Debug "fülle Array"
RandomSeed(5)
For i=0 To anz
test(i)\x=Random(430000)
test(i)\y=Random(32766)
Next i
st=ElapsedMilliseconds()
SortStructuredArray(test(),#PB_Sort_Ascending,OffsetOf(test\y),#PB_Word)
st1=ElapsedMilliseconds()
Debug "Zeit standard "+Str(st1-st)
Debug "fülle Array"
RandomSeed(5)
For i=0 To anz
testms(i)\x=Random(430000)
testms(i)\y=Random(32766)
Next i
mt=ElapsedMilliseconds()
MergeSort_Array(@testms(0),OffsetOf(test\y),SizeOf(test),#PB_Word,0,anz)
mt1=ElapsedMilliseconds()
Debug "Zeit multi "+Str(mt1-mt)
Debug "fülle Array"
RandomSeed(5)
For i=0 To anz
testmss(i)\x=Random(430000)
testmss(i)\y=Random(32766)
Next i
mts=ElapsedMilliseconds()
MergeSort_Array(@testmss(0),OffsetOf(test\y),SizeOf(test),#PB_Word,0,anz,#True)
mts1=ElapsedMilliseconds()
Debug "Zeit merge singlethrad "+Str(mts1-mts)
MessageRequester("Zeiten","Zeit standard "+Str(st1-st)+#LFCR$+"Zeit multimerge "+Str(mt1-mt)+#LFCR$+"Zeit singlemerge "+Str(mts1-mts))