Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Medianwert aus QSort-Beispiel von ytwinky
| Uploader: |  satsatt |
| Datum/Zeit: | 22.08.2011 22:36:22 |
'AnzeigeCheck:|Il1 sind Alt-0124, Großes i, kleines L, Eins „ä”öüáߎę֚Üñ±¸©ø°
'program QSort;
'(c)vor ganz langer Zeit von jemand, der in pascal programmieren konnte..
'program QSort.Pas wurde erfolgreich nach FB QSort.Bas portiert, auch FB0.17f
'qsort sortiert ein Array von SortTypes aufwärts und abwärts und benutzt jetzt Pointer
Type SortType As Integer 'Alle FB-Tpen erlaubt, bei Strings muß nur die Erzeugung geändert werden
'UDTs sind allerdings nicht erlaubt..
'FBE 1.0.7.6c erweitert um die Median Ermittlung ( z.B. zur Messwertglättung , natürlich nur für Zahlen)
Declare Sub QSort(Feld() As SortType Ptr, byVal l As Integer, byVal r As Integer, byVal Downwards As Integer=0)
Declare Sub PrMat(byVal Msg As String="", a() As SortType Ptr)
'Const Max=10
Dim Shared Max As Integer=10 '> 0 Testanzahl
Var j=0
Dim a(Max) As SortType Ptr
Randomize Timer
For j=0 To Max-1
a(j)=CAllocate(1, Len(SortType))
*a(j)=Rnd*30000
Next
PrMat("Unsortiert", a())
QSort(a(), 0, Max-1, 1)
PrMat("Abw„rts", a())
QSort(a(), 0, Max-1, 0)
PrMat("Aufw„rts", a())
'Print *a((Max + 1) / 2 -1) ' Median (n+1)/2 ungerade n
'Print (*a(Max / 2 -1) + *a(Max / 2 )) / 2 ' Median ((n/2)+(n+1)/2)/2 gerade n
'Print Max And 1 ' "ungerade1/gerade0"
If Max And 1 Then
Print "Median n=ungerade :" ;*a((Max + 1) / 2 -1);
Else
Print "Median n=gerade :" ;(*a(Max / 2 -1) + *a(Max / 2 )) / 2 ;
EndIf
GetKey
For j=0 To Max-1 'und jetzt den zugewiesenen Speicher noch freigeben..
DeAllocate(a(j))
a(j)=0
Next
End
Sub PrMat(byVal Msg As String="", a() As SortType Ptr)
Dim i As Integer=0
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 Ptr, byVal l As Integer, byVal r As Integer, byVal Downwards As Integer=0)
Var i=l, j=r 'Variablen für die Schleifensteuerung festlegen
Dim As SortType Ptr x=CAllocate(1, Len(SortType)) 'Speicher für Referenz-Element reservieren
*x=*Feld((l+r)\2) 'Referenz-Element ermitteln, das 'Mittelste' im Feld
Do
While IIF(Downwards, *Feld(i)>*x, *Feld(i)<*x) 'Einpassendes 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
DeAllocate(x) 'Speicher von x freigeben..
x=0
End Sub