XProfan

WindowTitle "NONREKURSIVES QUICKSORT"
'Getestet, aber ohne Gewähr, P. Specht in XProfan-11.2a free
Declare NumMax&,A&[],Stack1&[],Stack2&[],StackPtr&,HeadPtr&,TailPtr&
declare Pivot&,a&,b&,t&,q&,r&,p&,s&
declare i&,ms1&,sec!
Jump0:
Cls
Print "Wieviele Random Numbers?:";
Input NumMax&
Randomize:i&=0

While i&<NumMax&

    A&[i&]=Rnd(100000)
    Locate 2,2:print i&,A&[i&]''''
    Inc i&

EndWhile

ms1& = &GetTickCount''''
StackPtr&=0
HeadPtr&=0
TailPtr&=NumMax&-1
Print "Starte Nonrekursives Quicksort...";''''
Jump2:

While HeadPtr& < TailPtr&

    Pivot& = A&[(HeadPtr& + TailPtr&)/2]
    a& = HeadPtr&
    b& = TailPtr&
    Jump1:

    While A&[a&] < Pivot&

        inc a&

    EndWhile

    While A&[b&] > Pivot&

        dec b&

    EndWhile

    If a& < b&

        t&=A&[a&]
        A&[a&]=A&[b&]
        A&[b&]=t&
        inc a&
        dec b&
        Goto "Jump1"

    EndIf

    If a&=b&

        q& = b& - 1
        r& = a& + 1

    Else

        q& = b&
        r& = a&

    EndIf

    inc StackPtr&
    p& = HeadPtr&
    s& = TailPtr&

    If (q&-p&) < (s&-r&)

        Stack1&[StackPtr&] = r&
        Stack2&[StackPtr&] = s&
        HeadPtr& = p&
        TailPtr& = q&

    Else

        Stack1&[StackPtr&] = p&
        Stack2&[StackPtr&] = q&
        HeadPtr& = r&
        TailPtr& = s&

    EndIf

EndWhile

If StackPtr& > 0

    HeadPtr& = Stack1&[StackPtr&]
    TailPtr& = Stack2&[StackPtr&]
    dec StackPtr&
    Goto "Jump2"

EndIf

' Sortierung fertig
sec!=(&GetTickCount - ms1&)/1000
print:Print "Kontrollausgabe (jedes " + str$(int(NumMax&/30+1))+". Element):"''''

WhileLoop 0,NumMax&-1,int(1+NumMax&/30)

    Print A&[&Loop];
    EndWhile:print''''
    print:print "Dauer des reinen Sortiervorgangs der "+str$(NumMax&)+" Zufallsvariablen: "+str$(sec!)+" Sek."
    print:print "Weiterer Test mit beliebiger Taste..."
    WaitInput
    Goto "Jump0"