Aktuelle Zeit: 28.11.2020 22:20

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 13 Beiträge ]  Gehe zu Seite 1, 2  Nächste
Autor Nachricht
 Betreff des Beitrags: Mergesort für Array
BeitragVerfasst: 11.12.2017 20:16 
Offline

Registriert: 29.10.2011 16:54
Hallo,
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:
;******************

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






Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mergesort für Array
BeitragVerfasst: 11.12.2017 21:54 
Offline
verheiratet<br>1. PureGolf-Gewinner
Benutzeravatar

Registriert: 29.08.2004 09:42
Wohnort: Old Europe
Was ist an QuickSort "instabil" ?

_________________
Basic Pur = PureBasic


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mergesort für Array
BeitragVerfasst: 11.12.2017 22:13 
Offline

Registriert: 29.10.2011 16:54
Hallo, bevor ich eigene Worte finde, hier die Bechreibung aus der Hilfe von Purebasic

"Manchmal müssen Elemente sortiert sein, um überhaupt oder einfacher verwendbar zu sein. PureBasic bietet hoch optimierte Funktionen zum Sortieren von Arrays und verknüpften Listen - entweder in aufsteigender oder in absteigender Reihenfolge.
Weiterhin gibt es Funktionen, um die Elemente eines Arrays oder einer verknüpften Liste in einer zufälligen Reihenfolge neu anzuordnen.
SortStructuredList() und SortList() verwenden 'Mergesort', was eine "stabile Sortierung" (englisch "stable sort") darstellt - wenn Sie also z.B. erst die gesamte Liste nach Titeln und dann nochmal nach Album sortieren, werden Sie eine Liste erhalten, die nach Alben und jedes Album nach Titel sortiert ist.
Beachten Sie bitte, dass dies nicht bei Arrays funktioniert, da SortArray() 'Quicksort' verwendet, was "nicht stabil" (englisch "unstable") ist. D.h. die Sortierung nach dem zweiten Schlüssel geht verloren. "


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mergesort für Array
BeitragVerfasst: 12.12.2017 11:06 
Online
Ein Admin
Benutzeravatar

Registriert: 29.08.2004 20:20
Wohnort: Saarbrücken
Kurzgesagt: Ein stabiles Sortierverfahren behält die Reihenfolge der Elemente, die den gleichen Wert haben, bei.

Das ist natürlich nur relevant bei, wenn man strukturierte Listen sortiert.

_________________
Ubuntu Gnome 20.04 LTS x64, PureBasic 5.72 x64 (außerdem 4.41, 4.50, 4.61, 5.00, 5.10, 5.11, 5.21, 5.22, 5.30, 5.31, 5.40, 5.50, 5.60, 5.71b2)
"Die deutsche Rechtschreibung ist Freeware, du darfst sie kostenlos nutzen – Aber sie ist nicht Open Source, d. h. du darfst sie nicht verändern oder in veränderter Form veröffentlichen."


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mergesort für Array
BeitragVerfasst: 22.12.2019 09:56 
Offline

Registriert: 16.03.2006 11:20
Die Routine gefällt mir gut, wollte noch die Sortierrichtung angeben bzw. die Angabe des Sortierbereichs optional gestalten...
...kann man eigentlich die Arraygröße bestimmen, wenn nur die Adresse des Arrays übergeben wird?

Code:
Aktualisierter Code im nächsten Posting.


Zuletzt geändert von Michael Vogel am 22.12.2019 17:41, insgesamt 1-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mergesort für Array
BeitragVerfasst: 22.12.2019 16:37 
Offline

Registriert: 29.10.2011 16:54
Hallo, schön das Dir die Routine gefällt.

Zu Deiner Frage, ob die größe des Array herausgefunden werden kann, wenn nur die Adresse übergeben wird.
Kann ich leider nur sagen, das ich es nicht weiss. Allerdings muss PB intern dies abspeichern, da er es ansonsten nicht sauber freigeben könnte, bzw. einen Redim durchführen.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mergesort für Array
BeitragVerfasst: 22.12.2019 17:40 
Offline

Registriert: 16.03.2006 11:20
Danke, hab's gefunden und eingebaut (If \endright<0 : \endright=PeekL(*liste-8)-1 : EndIf), jetzt kann man die Parameter am Ende weglassen...

Habe das Beispiel auch leicht aufgemotzt, um Umlaute einigermaßen zu behandeln, dabei wird allerdings für Sortierkriterien ein zusätzliches Feld notwendig (im Beispiel SortName, SortAddress). Mit der Konstanten #UmOrder bestimmt man, wie Umlaute gereiht werden sollen.

Code:
; Define MergeSort

   #Undefined=-1

   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
      direction.i; up/down 0/1
   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 direction=*data\direction
      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)
         ;bed=CompareMemoryString(*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-direction
         *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)
               ;bed=CompareMemoryString(*ele1\s,*ele\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=direction
               ;       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,direction=#PB_Sort_Ascending,first=#Undefined,last=#Undefined,singlethread=#False)

      ; Protected *mem
      Protected p1.MergeSort_array_Mcpu

      With p1

         \typ=feldtype
         \startleft=first
         \endright=last
         \liste=*liste
         \size=sizeofstructure
         \offset=offsetofelement
         \direction=direction

         If \startleft<0
            \startleft=0
         EndIf
         If \endright<0
            \endright=PeekL(*liste-8)-1
         EndIf

         If last-first<10 Or singlethread
            \deep=0; wir threaden nicht mehr da deep überschritten
         Else
            \deep=Sqr(CountCPUs())
         EndIf

      EndWith

      MergeSort_Array_mpcu(@p1)

   EndProcedure

; EndDefine
; Define SorterPlus

   #CharByte=#PB_Compiler_Unicode+1
   #CharSize=256<<(#PB_Compiler_Unicode<<3)-1
   
   #UmOrder=0;   0: Vokal ident mit dem Umlaut (O=Ö), 1: Vokal wird vor dem Umlaut gereiht (O, dann Ö)

   Global Dim Sorter(#CharSize)

   Procedure InitSorterTable()

      Protected i
      Protected char

      For i=0 To #CharSize
         char=Asc(UCase(Chr(i)))
         Select char
         Case 'Ä','Á','À','Â','Ã','Å','Æ'
            Sorter(i)='A'<<#UmOrder+#UmOrder
         Case 'Ö','Ó','Ò','Ô','Õ'
            Sorter(i)='O'<<#UmOrder+#UmOrder
         Case 'Ü','Ú','Ù','Û'
            Sorter(i)='U'<<#UmOrder+#UmOrder
         Case 'Ë','É','È','Ê'
            Sorter(i)='E'<<#UmOrder+#UmOrder
         Case 'Ï','Í','Ì','Î'
            Sorter(i)='I'<<#UmOrder+#UmOrder
         Case 'ß'
            Sorter(i)='S'<<#UmOrder+#UmOrder
         Case 'Ç'
            Sorter(i)='C'<<#UmOrder+#UmOrder
         Case 'Ð'
            Sorter(i)='D'<<#UmOrder+#UmOrder
         Case 'Ñ'
            Sorter(i)='N'<<#UmOrder+#UmOrder
         Case 'Ý'
            Sorter(i)='Y'<<#UmOrder+#UmOrder
         Default
            Sorter(i)=char<<#UmOrder
         EndSelect
      Next i

   EndProcedure
   Procedure.s SorterString(s.s)

      Protected *s.String
      Protected char.i
      Protected clear.s

      *s=@s
      Repeat
         char=PeekC(*s)
         If char
            clear+Chr(Sorter(char))
            *s+#CharByte
         EndIf
      Until char=0

      ProcedureReturn clear

   EndProcedure

   InitSorterTable()

   Structure DemoType
      Name.s
      Address.s
      Number.i
      SortName.s
      SortAddress.s
   EndStructure

   Global Dim Demo.DemoType(0)
   Global Dim Order(0)

   Global Count=15
   DataSection
      Data.s "Valdi","Pälgien"
      Data.s "Väkov","Moskau"
      Data.s "Vogel","Vöslau"
      Data.s "Vogel","Baden"
      Data.s "Vogel","VanDort"
      Data.s "Vögel","Wien"
      Data.s "Vögel","Österreich"
      Data.s "Vögel","Vösendorf"
      Data.s "Vögel","Vonunten"
      Data.s "Vögel","Polen"
      Data.s "Vuzla","Polen"
      Data.s "Vuzla","Pälgien"
      Data.s "Vuzlakov","Moskau"
      Data.s "Vuzl","Bärgen"
      Data.s "Väzl","Baden"
   EndDataSection

   ReDim Demo(Count-1)
   ReDim Order(Count-1)
   For i=0 To Count-1
      Order(i)=i
      With Demo(i)
         Read.s \Name
         Read.s \Address
         If i%3
            \Number=i+1
         Else
            \Number=99
         EndIf
         \SortName=SorterString(\Name)
         \SortAddress=SorterString(\Address)
      EndWith
   Next i

; EndDefine

;MergeSort_Array(@demo(),OffsetOf(DemoType\Number),SizeOf(DemoType),#PB_Integer,#PB_Sort_Ascending)
MergeSort_Array(@demo(),OffsetOf(DemoType\SortAddress),SizeOf(DemoType),#PB_String,#PB_Sort_Descending)
MergeSort_Array(@demo(),OffsetOf(DemoType\SortName),SizeOf(DemoType),#PB_String,#PB_Sort_Ascending)

For i=0 To count-1
   Debug Str(Demo(i)\Number)+"   "+Demo(i)\Name+"   "+Demo(i)\Address
Next i


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mergesort für Array
BeitragVerfasst: 22.12.2019 18:02 
Offline

Registriert: 27.11.2016 18:13
Wohnort: Erzgebirge
Hallo!

(Deprecated)
Zitat:
Also vorher hat es sortiert.

Mit deiner neusten Anpassung nicht mehr.


(New)
Es liegt an 64bit. Sorry!

_________________
Betriebssysteme: MX Linux 19 / Windows 10 / Mac OS 10.15.7 / Android 7.0 ;)

Manchmal muß das Rad neu erfunden werden.


Zuletzt geändert von ccode_new am 22.12.2019 20:24, insgesamt 1-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mergesort für Array
BeitragVerfasst: 22.12.2019 19:34 
Offline

Registriert: 16.03.2006 11:20
ccode_new hat geschrieben:
Hallo!

Also vorher hat es sortiert.

Mit deiner neusten Anpassung nicht mehr.


Schaut bei mir nicht anders aus als vorher?!
Das Beispiel sortiert die Namen aufsteigend, untergeordnet die Adressen (absteigend), Umlaute haben den gleichen Rang wie der "zugehörige" Vokal.

Was passt bei dir nicht?


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Mergesort für Array
BeitragVerfasst: 22.12.2019 20:09 
Offline

Registriert: 29.10.2011 16:54
Hallo, hab es ebenfalls getestet,
die Größe des Arrays kann wie oben gezeigt ermittelt werden allerdings:

32 Bit: @array()-8
64 Bit: @array()-16

Allerdings ist es nicht sicher das auch in zukunft immer so sein wird, sollte am Compiler mal etwas geändert werden.
Irgendwo muß er auch bei mehrdimensionalen Array's die Daten speichern. Die Frage bleibt, wie genau die Struktur dazu aufgebaut ist.


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 13 Beiträge ]  Gehe zu Seite 1, 2  Nächste

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 21 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye