Net-On's Banner Exchange - Business Advertising
<![CDATA[
ATARI @DL de:DG8FZ 28.10.96 08:41 0 2907 Bytes
GFA: Quicksort.BAS
*** Bulletin-ID: 067502DB0BID ***
Sent: 950706/1449z @DB0BID.#HES.DEU.EU [Biedenkopf TheBox DC2ZN] $:067502DB0BID
de DG8FZ @ DB0BID.#HES.DEU.EU (Karl)
to ATARI @ DL
#BIN#2550#|44436#$1C539198#QUICKSOR.LST
Main:
'
' quicksor.bas
'
' (c) 1995 DG8FZ
'
' dieser quicksort läuft unter GFA-Basic,
'
' er sortiert, so wie er jetzt eingebunden ist,
' 300 komma-freie checklistenzeilen
' alphabetisch nach dem betreff-feld
'
'
Gosub Io
'
End
'
'
Procedure Io
Print "checklisten-umsortierer"
Print "quelldateiname: sort"
Print "zieldatei: sort"
Print "tabellenformat: textzeilen ohne komma etc."
Print "endemarke : ***end"
Max=300
Marke%=255
Open "i",#1,"sort"
Dim Sd$(Max+2),Sd%(Max+2),Us$(Max+2)
X%=-1
Ab=55
For I=1 To Max
Input #1,X$
Exit If Mid$(X$,1,6)="***end"
' Exit If X$="" ! wenn alle zeilen etwas enthalten
X%=I
Gosub Trennen
Next I
Sd$(X%+1)=Chr$(Marke%)
Sd%(X%+1)=X%+1
Close #1
'
Gosub Quicksort
'
Open "o",#1,"sort"
For I=1 To Max
Exit If Sd$(I)=Chr$(Marke%)
Print Us$(Sd%(I));Sd$(I)
Print #1,Us$(Sd%(I));Sd$(I)
Next I
Print #1
Close #1
Return
'
Procedure Trennen
'
Print Mid$(X$,Ab,255)
Sd$(I)=Mid$(X$,Ab,255)
Us$(I)=Mid$(X$,1,Ab-1)
Sd%(I)=I
'
Return
'
Procedure Test
Max=10
Marke%=255
Dim Sd$(Max),Sd%(Max)
Sd$(1)="2"
Sd$(2)="1"
Sd$(3)="4"
Sd$(4)="3"
Sd$(5)=Chr$(Marke%)
Gosub Quicksort
For I=1 To Max
Print Sd$(I)
Next I
Return
'
Procedure Quicksort
'
' sortiert sd$(x), sd%(x) wird mit umsortiert, asc(letztem element) = marke%
'
Local S1,S2,Sf%,Sn,L1,L2,Sp,Sv,Sv$
Dim S1(Max),S2(Max)
Sn=0
L1=Marke%
Do
Exit If Asc(Sd$(Sn))=L1
Sn=Sn+1
Loop
Sn=Sn-1
Sp=0
S1(0)=0
S2(0)=Sn
Do
S1=S1(Sp)
S2=S2(Sp)
Sp=Sp-1
Do
L1=S1
L2=S2
Sd$=Sd$(Int((S1+S2)/2))
Do
Do
Exit If Not (Sd$(L1)<Sd$ And L1<S2)
L1=L1+1
Loop
Do
Exit If Not (Sd$(L2)>Sd$ And L2>S1)
L2=L2-1
Loop
If Not L1>L2
Sv=Sd%(L1)
Sd%(L1)=Sd%(L2)
Sd%(L2)=Sv
Sv$=Sd$(L1)
Sd$(L1)=Sd$(L2)
Sd$(L2)=Sv$
L1=L1+1
L2=L2-1
Endif
Exit If Not L1<=L2
Loop
If (S2-L1)>(L2-S1)
If S1<L2
Sp=Sp+1
S1(Sp)=S1
S2(Sp)=L2
Endif
S1=L1
Else
If L1<S2
Sp=Sp+1
S1(Sp)=L1
S2(Sp)=S2
Endif
S2=L2
Endif
Exit If Not S2>S1
Loop
Exit If Sp<0
Loop
Return
]]>
Null