Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Suchen und Sortieren

QSort - ShellSort

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.Redakteurytwinky 31.08.2010

Auf Externer Link!http://www.delphiseiten.de/ habe ich den Quellcode für mein QSort-Programm wiedergefunden..
..dort ist auch ein Programm für den ShellSort, was liegt also näher, als die beiden mal gegeneinander antreten zu lassen.
Die Umsetzung von Delphi/Pascal nach FB ist (eigentlich) kein Problem(wenn man Pascal kann :D).
Die Messung mit Timer ist natürlich keine exakte Bestimmung der Laufzeit, soll sie ja auch gar nicht sein.
Sie zeigt aber einen interessanten Trend auf: Ist die Matrix >70, hat eindeutig der QSort die Nase vorn, egal, welches Sortierschema ich für den Shell-Sort benutze.
Freundlicherweise ist der Shell-Sort so geschrieben, daß es keine Schwierigkeit ist, ihn auf- und abwärts sortieren zu lassen.
Das gilt jedoch nur für numerische Typen(z.B. Spielstände).
Vorteile des ShellSorts: Die Sortierung erfolgt direkt im übergebenen Array und es werden nur Variablen für die Schleifensteuerungen benötigt.
Nachteile: Ist eben ein wenig langsamer in der Ausführung

'AnzeigeCheck:|Il1 sind Alt-0124, Großes i, kleines L, Eins „ä”öüáߎę֚Üñ±¸©ø°
'program SortTest;
Type SortType As Integer 'Alle FB-Typen erlaubt, bei Strings muß nur die Erzeugung geändert werden
'UDTs sind allerdings nicht erlaubt..

Declare Sub b2a(b() As SortType, a() As SortType)
Declare Sub QSort(Feld() As SortType, byVal l As Integer, byVal r As Integer, byVal Downwards As Integer=0)
Declare Sub ShellSort(Feld() As SortType, byVal l As Integer, byVal r As Integer, byVal Downwards As Integer=0)
Declare Sub PrMat(byVal Msg As String="", a() As SortType)

Const Max=10
Dim j As Integer
Dim As SortType a(Max), b(Max)
Dim As Double Zeit(0 To 3), Mittel
Randomize Timer

For j=0 To Max-1
  b(j)=Rnd*30000 'Matrix-Elemente erzeugen
  a(j)=b(j)'umkopieren
Next j

PrMat("Unsortiert", a())
Zeit(0)=Timer
QSort(a(), 0, Max-1, 1)
Zeit(0)=(Timer-Zeit(0))*18000
Mittel+=Zeit(0)
PrMat("QSort Abw„rts " &Zeit(0), a())

b2a(b(), a()) 'umkopieren
Zeit(1)=Timer
QSort(a(), 0, Max-1, 0)
Zeit(1)=(Timer-Zeit(1))*18000
Mittel+=Zeit(1)
PrMat("QSort Aufw„rts " &Zeit(1), a())

b2a(b(), a()) 'umkopieren
Zeit(2)=Timer
ShellSort(a(), 0, Max-1, 1)
Zeit(2)=(Timer-Zeit(2))*18000
Mittel+=Zeit(2)
PrMat("ShellSort Abw„rts " &Zeit(2), a())

b2a(b(), a()) 'umkopieren
Zeit(3)=Timer
ShellSort(a(), 0, Max-1, 0)
Zeit(3)=(Timer-Zeit(3))*18000
Mittel+=Zeit(3)
PrMat("ShellSort Aufw„rts " &Zeit(3), a())
Print "Mittelwert";Tab(20); Str(Mittel/4)

GetKey
End

Sub b2a(b() As SortType, a() As SortType)
  Dim i As Integer
  For i=LBound(b) To UBound(b)
    a(i)=b(i)
  Next i
End Sub

Sub PrMat(byVal Msg As String="", a() As SortType)
  Dim i As Integer
  If Msg<>"" Then Print Msg
  For i=0 To Max-1
    Print Using"####:";i;
    Print a(i)
  Next
End Sub

Sub QSort(Feld() As SortType, byVal l As Integer, byVal r As Integer, byVal Downwards As Integer=0)
  Dim As Integer i=l, j=r 'Variablen für die Schleifensteuerung festlegen
  Dim As SortType x
  x=Feld((l+r)\2) 'Referenz-Element ermitteln, das 'Mittelste' im Feld
  Do
    While IIF(Downwards, Feld(i)>x, Feld(i)<x) 'Ein passendes Vergleichselement finden
      i+=1 'Zähler erhöhen
    Wend
    While IIF(Downwards, x>Feld(j), x<Feld(j)) 'Noch ein passendes Element finden
      j-=1
    Wend
    If i<=j Then 'ggfs.
      Swap Feld(i), Feld(j) '..tauschen
      i+=1 'Zähler erhöhen..
      j-=1 '..diesen erniedrigen..
    End If
  Loop Until i>j
  If l<j Then QSort(Feld(), l, j, Downwards) 'ggfs mit den neuen Grenzen sortieren
  If i<r Then QSort(Feld(), i, r, Downwards) 'anderenfalls mit den neuen Grenzen sortieren
  x=0
End Sub

Sub ShellSort(Zahl() As SortType, byVal l As Integer, byVal Size As Integer, byVal Downwards As Integer=0)
  Static Steps(0 To 2) As Integer={4, 2, 1} '5, 3, 1 als Alternative
  Dim As Integer i, j, k, p, t, Direction=IIF(Downwards=0, 1, -1)
  For k=0 To 2
    For p=0 To Steps(k)
      For i=1 To ((Size-p)\Steps(k))
        If Direction*Zahl(i*Steps(k)+p)<Direction*Zahl((i-1)*Steps(k)+p) Then
          j=i*Steps(k)+p
          t=Zahl(j)
          While Direction*Zahl(j-Steps(k))>Direction*t And j>p
            Zahl(j)=Zahl(j-Steps(k))
            j-=Steps(k)
          Wend
          Zahl(j)=t
        End If
      Next i
    Next p
  Next k
End Sub

[Edit]Auf Anregung von MisterD habe ich die Variablen von Long auf Integer gesetzt..
Gruß
ytwinky


Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 06.07.2007 von Redakteurytwinky angelegt.
  • Die aktuellste Version wurde am 31.08.2010 von Redakteurytwinky gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen