Logo Foltyn Presentation
Table of Contents Previous Page Next Page
Content-Symbol-Img
Ein Programm in der Programmiersprache A program in the programming language
vbScript
zum Sortieren von Elementen einer Liste for sorting of elements in a list

Das ist vielleicht die schnellste Sortiermethode. Das Programm sucht in allen Elementen eines Stapels von unsortierten Elementen den Minimalwert (bei Sortieren in aufsteigender Reihenfolge) und den Maximalwert (bei Sortieren in absteigender Reihenfolge) und tauscht dann das gefundene Element mit dem ersten Element des unsortierten Stapels aus. Dann wird der Stapel der unsortierten Elemente um eins verkleinert und das wird so lange wiederholt, bis der unsortierte Stapel abgearbeitet ist.

This is perhaps the fastest search-method. The program seeks in all elements of a pile of unsorted elements the minimal value (if upwards order sorting) or the maximal value (if downwards order sorting) and exchanges the found element with the first element of the unsorted. Then the pile of unsorted elements is lowered by one and this is repeated until the pile of unsorted is worked off.

Das Programm ist getestet vor der Publikation, aber es kann keine Garantie gegeben werden, dass es fehlerfrei ist
The program ist tested before publication, but there can be given no guarantee, that it is free of errors
8. Aug. 2012 Aug 8th 2012

' QuickSort (this is probably the quickest sort-method)

Option Explicit

' Declaration of Constants and Array

Const Up = 1, Down = -1
Dim i, List: ReDim List(30)

' Program (for demonstration of the function of the QuickSort-Procedure)

Randomize ' Creating a List
For i = 0 To UBound(List)
    List(i) = Int(200*Rnd)
Next

' Display Function

MsgBox Join(List,vbCrLf),,"UnsortedList"
List = QuickSort(Up,List)
MsgBox Join(List,vbCrLf),,"SortedList Up"
List = QuickSort(Down,List)
MsgBox Join(List,vbCrLf),,"SortedList Down"

' End of Program

' Procedures

Function QuickSort(SortDirection, AnyArray)
    ' Seeks among an unsorted pile the max (or min if SortDirection = Down) by running through
    ' all unsorted items and exchanges the found peak-value with the first item of the unsorted pile
    ' Then it lowers the unsorted pile and repeats the procedure until the pile is worked off
    Dim ItemPos, Pointer, PointerToPeakValue, sTmp, CmpOp, SD: SD = SortDirection
    If UBound(AnyArray) > -1 And Abs(SD) = 1 Then
        For ItemPos = 0 To UBound(AnyArray): PointerToPeakValue = ItemPos
            For Pointer = ItemPos + 1 To UBound(AnyArray): CmpOp = 0
                If AnyArray(Pointer) < AnyArray(PointerToPeakValue) Then CmpOp = -1
                If AnyArray(Pointer) > AnyArray(PointerToPeakValue) Then CmpOp = 1
                If CmpOp <> SD Then PointerToPeakValue = Pointer
            Next
            sTmp = AnyArray(PointerToPeakValue)
            AnyArray(PointerToPeakValue) = AnyArray(ItemPos)
            AnyArray(ItemPos) = sTmp
        Next
    End If: QuickSort = AnyArray
End Function

' End of Procedures