Code-Beispiel

QSort - ShellSort

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

Auf 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 ytwinky angelegt.
Die aktuellste Version wurde am 31.08.2010 von ytwinky gespeichert.

Bearbeiten

Versionen