Aktuelle Zeit: 12.07.2020 20:28

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 1 Beitrag ] 
Autor Nachricht
 Betreff des Beitrags: SortStructuredArrayEx mit Gnome-Sort (stabil)
BeitragVerfasst: 04.12.2006 13:07 
Offline
Ein Admin
Benutzeravatar

Registriert: 29.08.2004 20:20
Wohnort: Saarbrücken
Hallo alle miteinander!

Da ich eben etwas Zeit hatte, habe ich Xaby bei einem Sortier-Problem
geholfen. Dabei kam folgende Procedure heraus.
Sie hat ähnliche Parameter wie die Funktion SortStructuredArray(), allerdings
muss man noch die Größe der Struktur übergeben und Start- und
End-Parameter sind nicht optional, was man theoretisch aber ändern könnte.

Hier also der Code mit Beispiel:
Code:
Structure Daten
  s1.s
  a1.l
  s2.s
EndStructure
Dim Daten.Daten(5)


;Benutzt den GNOME-Sort
Procedure SortStructuredArrayEx(*Array, Options.l, size_arr.l, offset.l, Type.l, start.l, ende.l)
  Protected a.l = start, r.l, *s_arr, *e_arr, *tmp
 
  *tmp = AllocateMemory(size_arr)
  If *tmp = 0 : ProcedureReturn #False : EndIf
 
  *s_arr = *Array + a * size_arr + offset
  While a <= ende - 1
    *e_arr = *s_arr + size_arr
    r = #False
    Select Options
      Case 0
        Select Type
          Case #PB_Sort_Byte      : If PeekB(*s_arr) > PeekB(*e_arr) : r = #True : EndIf
          Case #PB_Sort_Character : If PeekC(*s_arr) > PeekC(*e_arr) : r = #True : EndIf
          Case #PB_Sort_Double    : If PeekD(*s_arr) > PeekD(*e_arr) : r = #True : EndIf
          Case #PB_Sort_Float     : If PeekF(*s_arr) > PeekF(*e_arr) : r = #True : EndIf
          Case #PB_Sort_Long      : If PeekL(*s_arr) > PeekL(*e_arr) : r = #True : EndIf
          Case #PB_Sort_Quad      : If PeekQ(*s_arr) > PeekQ(*e_arr) : r = #True : EndIf
          Case #PB_Sort_String    : If PeekS(PeekL(*s_arr)) > PeekS(PeekL(*e_arr)) : r = #True : EndIf
          Case #PB_Sort_Word      : If PeekW(*s_arr) > PeekW(*e_arr) : r = #True : EndIf
        EndSelect
      Case 1
        Select Type
          Case #PB_Sort_Byte      : If PeekB(*s_arr) < PeekB(*e_arr) : r = #True : EndIf
          Case #PB_Sort_Character : If PeekC(*s_arr) < PeekC(*e_arr) : r = #True : EndIf
          Case #PB_Sort_Double    : If PeekD(*s_arr) < PeekD(*e_arr) : r = #True : EndIf
          Case #PB_Sort_Float     : If PeekF(*s_arr) < PeekF(*e_arr) : r = #True : EndIf
          Case #PB_Sort_Long      : If PeekL(*s_arr) < PeekL(*e_arr) : r = #True : EndIf
          Case #PB_Sort_Quad      : If PeekQ(*s_arr) < PeekQ(*e_arr) : r = #True : EndIf
          Case #PB_Sort_String    : If PeekS(PeekL(*s_arr)) < PeekS(PeekL(*e_arr)) : r = #True : EndIf
          Case #PB_Sort_Word      : If PeekW(*s_arr) < PeekW(*e_arr) : r = #True : EndIf
        EndSelect
      Case 2
        If Type = #PB_Sort_String
          If LCase(PeekS(PeekL(*s_arr))) > LCase(PeekS(PeekL(*e_arr))) : r = #True : EndIf
        EndIf
         
      Case 3
        If Type = #PB_Sort_String
          If LCase(PeekS(PeekL(*s_arr))) < LCase(PeekS(PeekL(*e_arr))) : r = #True : EndIf
        EndIf
    EndSelect
   
    If r
      CopyMemory(*s_arr - offset, *tmp, size_arr)
      CopyMemory(*e_arr - offset, *s_arr - offset, size_arr)
      CopyMemory(*tmp, *e_arr - offset, size_arr)
      If a > start
        a - 2
        *s_arr - 2 * size_arr
      EndIf
    EndIf
    a + 1
    *s_arr + size_arr
  Wend
EndProcedure

Daten(0)\s1 = "AA" : Daten(0)\a1 = 100 : Daten(0)\s2 = "CD"
Daten(1)\s1 = "BC" : Daten(1)\a1 =  50 : Daten(1)\s2 = "CD"
Daten(2)\s1 = "AA" : Daten(2)\a1 =  30 : Daten(2)\s2 = "DF"
Daten(3)\s1 = "BB" : Daten(3)\a1 =  60 : Daten(3)\s2 = "AB"
Daten(4)\s1 = "BB" : Daten(4)\a1 =  20 : Daten(4)\s2 = "CD"
Daten(5)\s1 = "BB" : Daten(5)\a1 =  25 : Daten(5)\s2 = "AD"

SortStructuredArrayEx(Daten(), 0, SizeOf(Daten), OffsetOf(Daten\a1), #PB_Sort_Long, 0, 5)
SortStructuredArrayEx(Daten(), 0, SizeOf(Daten), OffsetOf(Daten\s2), #PB_Sort_String, 0, 5)
SortStructuredArrayEx(Daten(), 0, SizeOf(Daten), OffsetOf(Daten\s1), #PB_Sort_String, 0, 5)

For a = 0 To 5
  Debug Daten(a)\s1 + " : " + Str(Daten(a)\a1) + " : " + Daten(a)\s2
Next

_________________
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  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 1 Beitrag ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: Nino und 7 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