Sortieralgorithmen

Übersicht

BlitzBasic

Codearchiv

	Eingeproggt Betreff: Sortieralgorithmen	Do, Apr 12, 2007 18:15 Antworten mit Zitat
Dank überwältigender Hilfe eurerseits (hier: https://www.blitzforum.de/foru...hp?t=23116) kann ich nach nur 3 Tagen Entwicklungszeit meine nicht Laufzeitoptimierte, nur für Types ausgelegte Sortierfunktion InsertSort vorstellen. EDIT: Jetzt zigmal schneller! Hatte einen Denkfehler drin, dass er jeden Schleifendurchlauf unnötig oft gemacht hat. BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN] ;Insert Sort für Strings (in Types) ; ;Diese Funktion ist weniger für Zahlen geeeignet ; ;flag 1=Aufsteigend ; 0=Absteigend sortieren ; ;Möglicherweise funktioniert diese Funktion auch ohne dem Type-Feld "num" ;So hatte ich es allerdings in meinem Programm gebraucht und es gelassen. Type list_el Field name$ Field num ;Event. noch mehr, je nach Bedarf End Type Function sort(flag) elx.list_el=After First list_el ;Das erste Element wird als sortiert angesehen Repeat el1.list_el=elx vergl1$="_"+el1\name ;vergl darf kein leerer String sein el2.list_el=First list_el While el2<>el1 vergl2$="_"+el2\name i=1 : zahl1=0 : zahl2=0 ;Vergleichbare Zahlen erstellen While zahl1=zahl2 And i<Len(vergl1) And i<Len(vergl2) zahl1=Asc(Mid(vergl1,i,1)) zahl2=Asc(Mid(vergl2,i,1)) i=i+1 Wend ;Eigentlicher Vergleich If ((flag And zahl1<zahl2) Or (flag=0 And zahl1>zahl2)) And el1\num>el2\num Then el1\num=el2\num ;Alle anderen weiterschieben elx.list_el=el2 While elx<>el1 If elx\num>=el2\num Then elx\num=elx\num+1 EndIf elx=After elx Wend elx=After el1 ;Element einfügen Insert el1 Before el2 Exit EndIf el2=After el2 Wend Until elx=Null End Function Achja, der Titel ist in der Mehrzahl, weil ich hoffe, dass viele weitere folgen. EDIT 9.1.2010: Code Tags in BB-Code-Tags geändert.

Eingeproggt

Betreff: Sortieralgorithmen

Do, Apr 12, 2007 18:15
Antworten mit Zitat

Dank überwältigender Hilfe eurerseits (hier: https://www.blitzforum.de/foru...hp?t=23116) kann ich nach nur 3 Tagen Entwicklungszeit meine nicht Laufzeitoptimierte, nur für Types ausgelegte Sortierfunktion

InsertSort

vorstellen.
EDIT: Jetzt zigmal schneller! Hatte einen Denkfehler drin, dass er jeden Schleifendurchlauf unnötig oft gemacht hat.

BlitzBasic: [AUSKLAPPEN]


;Insert Sort für Strings (in Types)
;
;Diese Funktion ist weniger für Zahlen geeeignet
;
;flag 1=Aufsteigend
;     0=Absteigend  sortieren
;
;Möglicherweise funktioniert diese Funktion auch ohne dem Type-Feld "num"
;So hatte ich es allerdings in meinem Programm gebraucht und es gelassen.

Type list_el
	Field name$
	Field num
	;Event. noch mehr, je nach Bedarf
End Type

Function sort(flag)
	elx.list_el=After First list_el ;Das erste Element wird als sortiert angesehen
	Repeat
		el1.list_el=elx
		vergl1$="_"+el1\name ;vergl darf kein leerer String sein
		el2.list_el=First list_el
		While el2<>el1
			vergl2$="_"+el2\name
			i=1 : zahl1=0 : zahl2=0
			;Vergleichbare Zahlen erstellen
			While zahl1=zahl2 And i<Len(vergl1) And i<Len(vergl2)
				zahl1=Asc(Mid(vergl1,i,1))
				zahl2=Asc(Mid(vergl2,i,1))
				i=i+1
			Wend
			;Eigentlicher Vergleich
			If ((flag And zahl1<zahl2) Or (flag=0 And zahl1>zahl2)) And el1\num>el2\num Then
				el1\num=el2\num
				;Alle anderen weiterschieben
				elx.list_el=el2
				While elx<>el1
					If elx\num>=el2\num Then
						elx\num=elx\num+1
					EndIf
					elx=After elx
				Wend
				elx=After el1
				;Element einfügen
				Insert el1 Before el2
				Exit
			EndIf
			el2=After el2
		Wend
	Until elx=Null
End Function

Achja, der Titel ist in der Mehrzahl, weil ich hoffe, dass viele weitere folgen.

EDIT 9.1.2010: Code Tags in BB-Code-Tags geändert.

Zuletzt bearbeitet von Eingeproggt am Sa, Jan 09, 2010 16:07, insgesamt einmal bearbeitet

	Rallimen Sieger des 30-EUR-Wettbewerbs	Do, Apr 12, 2007 19:53 Antworten mit Zitat
Dann will ich mal anschließen mit 2 Algo´s einmal Insert und einmal Quicksort nur für Types Der folgende Code beinhaltet gleich eine Speedmessung! Code: [AUSKLAPPEN] [EINKLAPPEN] Graphics 800,200,16,2 Type TY Field x End Type ;Vorgabe Anzzahl = 5000 Seedrandom=MilliSecs() ZahlStart=1 ZahlEnde = 500000 ;testet die Speed von (Insert Sortieren Mit For Next) NeueErstellen(Anzzahl,Seedrandom,ZahlStart,ZahlEnde ) time = MilliSecs (): InsertSortierenMitForNext() :Time = MilliSecs () - time Print Time + " Millisekunden InsertSortierenMitForNext()" ;testet die Speed von (Quicksort()) NeueErstellen(Anzzahl,Seedrandom,ZahlStart,ZahlEnde ) time = MilliSecs (): Quicksort_Start() :Time = MilliSecs () - time Print Time + " Millisekunden Quicksort()" WaitKey Function NeueErstellen(Anz,zufall,von,bis ) SeedRnd(zufall) Delete Each TY For i= 1 To Anz t.TY= New TY t\x = Rand(von,bis) Next End Function Function InsertSortierenMitForNext(); 5_1_2007 For a.Ty = Each TY z.TY = After a.TY If z.TY <> Null Then If z\x < a\x For z1.TY = Each TY If z\x < z1\x Then Insert z Before z1 a.TY=Before a.TY Exit End If Next End If End If Next End Function Function Quicksort_Start() a.TY= First TY b.TY = Last TY If a.TY = Null Return If a <> b Then Quicksort(a.TY,b.TY) End Function Function Quicksort(a.TY,b.TY) s2.Ty = A.TY s3.TY = A.TY Repeat s1.TY=After s2.TY If s1\x< a\x Then If s1 = b.TY Then b.Ty=Before s1 GoOut = 1 Else s2= Before s1 End If Insert S1.TY Before a.TY If s3.TY = A.Ty Then s3.ty=s1.TY Else If s1.TY= b.Ty Then Exit s2.TY = s1 End If Until goout If s3.Ty <> a.TY s1 = Before a.TY If s1<> s3 Then Quicksort(s3.TY,s1.TY) End If If a.Ty <> b.TY s1 = After a.TY If s1 <> b Then Quicksort(s1.TY,b.TY) End If End Function Für den Quicksort habe ich extra ein Pgrammgeschrieben, mit dem der SourceCode erstellt wird. Einfach Typename und Field angeben nach dem sortiert werden soll, der Code wird in die Zwischenablage kopiert. Download

Rallimen

Sieger des 30-EUR-Wettbewerbs

Do, Apr 12, 2007 19:53
Antworten mit Zitat

Dann will ich mal anschließen mit 2 Algo´s

einmal Insert und einmal Quicksort nur für Types

Der folgende Code beinhaltet gleich eine Speedmessung!
Code: [AUSKLAPPEN]

Graphics 800,200,16,2
Type TY Field x End Type
;Vorgabe
Anzzahl = 5000
Seedrandom=MilliSecs()
ZahlStart=1
ZahlEnde = 500000

;testet die Speed von (Insert Sortieren Mit For Next)
NeueErstellen(Anzzahl,Seedrandom,ZahlStart,ZahlEnde )
time = MilliSecs (): InsertSortierenMitForNext() :Time = MilliSecs () - time
Print Time + " Millisekunden InsertSortierenMitForNext()"

;testet die Speed von (Quicksort())
NeueErstellen(Anzzahl,Seedrandom,ZahlStart,ZahlEnde )
time = MilliSecs (): Quicksort_Start() :Time = MilliSecs () - time
Print Time + " Millisekunden Quicksort()"

WaitKey

Function NeueErstellen(Anz,zufall,von,bis )
SeedRnd(zufall)
Delete Each TY
For i= 1 To Anz
   t.TY= New TY
   t\x = Rand(von,bis)
Next
End Function

Function InsertSortierenMitForNext(); 5_1_2007
For a.Ty = Each TY
   z.TY = After a.TY
   If z.TY <> Null Then
      If z\x < a\x
         For z1.TY = Each TY
            If z\x < z1\x Then
               Insert z Before z1
               a.TY=Before a.TY
               Exit
            End If
         Next
      End If
   End If
Next
End Function

Function Quicksort_Start()
a.TY= First TY
b.TY = Last TY
If a.TY = Null Return
If a <> b Then Quicksort(a.TY,b.TY)
End Function
Function Quicksort(a.TY,b.TY)
s2.Ty = A.TY
s3.TY = A.TY
Repeat
s1.TY=After s2.TY
If s1\x< a\x Then
If s1 = b.TY Then
b.Ty=Before s1
GoOut = 1
Else
s2= Before s1
End If
Insert S1.TY Before a.TY
If s3.TY = A.Ty Then s3.ty=s1.TY
Else
If s1.TY= b.Ty Then Exit
s2.TY = s1
End If
Until goout
If s3.Ty <> a.TY
s1 = Before a.TY
If s1<> s3 Then Quicksort(s3.TY,s1.TY)
End If
If a.Ty <> b.TY
s1 = After a.TY
If s1 <> b Then Quicksort(s1.TY,b.TY)
End If
End Function

Für den Quicksort habe ich extra ein Pgrammgeschrieben, mit dem der SourceCode erstellt wird.
Einfach Typename und Field angeben nach dem sortiert werden soll, der Code wird in die Zwischenablage kopiert.
Download

	Kabelbinder Sieger des WM-Contest 2006	Sa, Apr 14, 2007 13:25 Antworten mit Zitat
Fehlt noch Mergesort .
<Wing Avenger Download> ◊◊◊ <Macrophage Download>

Kabelbinder

Sieger des WM-Contest 2006

Sa, Apr 14, 2007 13:25
Antworten mit Zitat

Fehlt noch Mergesort Very Happy