BPS #2: Wörter sortieren - Auswertung

Übersicht BlitzMax, BlitzMax NG Beginners-Corner

Neue Antwort erstellen

Xeres

Moderator

Betreff: BPS #2: Wörter sortieren - Auswertung

 BeitragDo, Feb 10, 2011 10:45
Antworten mit Zitat
Benutzer-Profile anzeigen
So, die Zeit ist 'rum!

Das war die Aufgabe

Postet hier eure Ergebnisse, Codes, Gedanken. Lernt von den anderen, seht euch deren Quelltext an und versucht euren eigenen zu verbessern.

Diskussion
Postet zu euren Codes stets eine kurze Erklärung mit euren Gedanken in denen ihr simpel gesagt die Frage "Wieso habe ich XY auf diese Art gelöst?" beantwortet. Beiträge, die nur den Code enthalten werden wir aus dem Thread entfernen.

Nächste Aufgabe
In drei Tagen am Sonntag dem 13. wird die Musterlösung nach editiert und die nächste Aufgabe eingestellt.

Viel Spaß & viel Erfolg!

Musterlösung:
Lösung 1:
BlitzMax: [AUSKLAPPEN] 
SuperStrict
'* Das Array wird mit der Liste der Wörter angelegt:
Global Words:String[] = ["Ich", "bin", "eine", "Ansammlung", "unsortierter",  ..
                        "Wörter", "welche", "sortiert", "werden", "müssen"]

SortStrings() ' Die Sortierfunkion wird aufegrufen

For Local i:Int = 0 Until Words.Length ' Die Strings werden sortiert ausgegeben
    Print(Words[i])
Next

End


Function SortStrings()
    ' Die benötigten Variablen werden lokal in der Function deklariert
    Local i:Int, j:Int, k:Int, tmp:String, byte_1:Byte, byte_2:Byte
    
    ' Die übergeordnete Schleife durchläuft die Sortierung 10 mal
    For i = 0 To 9
        ' Die nächste Schleife läuft "rückwärts" und sortiert das aktuelle Wort
        ' bedarfsweise über das darüberliegende ein
        For j = 9 To 1 Step - 1
            ' Die nächste Schleife dient ausschließlich dem Vergleich der Buchstaben.
            ' Ist der erste gleich dem Vergleichsbuchstaben wird der zweite verglichen. Ist
            ' auch dieser gleich, der dritte usw. bis zum Ende des Strings
            For k = 1 To Len(Words[j])
                byte_1 = Asc(Lower(Mid(Words[j - 1], k, 1)))
                byte_2 = Asc(Lower(Mid(Words[j], k, 1)))
                ' Ist das Zeichen nicht gleich springen wir aus der Schleife
                If byte_1 <> byte_2 Then Exit
            Next
            ' Wir vergleichen das Zeichen und tauschen ggf. die Position
            If byte_2 < byte_1 Then
                tmp = Words[j]
                Words[j] = Words[j - 1]
                Words[j - 1] = tmp
            EndIf
        Next
    Next
End Function


Lösung 2 (mit Compare-Funktion):
BlitzMax: [AUSKLAPPEN] 
SuperStrict
'* Das Array wird mit der Liste der Wörter angelegt:
Global Words:String[] = ["Ich", "bin", "eine", "Ansammlung", "unsortierter",  ..
                        "Wörter", "welche", "sortiert", "werden", "müssen"]
                        
rem
    Arrays besitzen in BlitzMax eine Sort Methode! Diese kann eine Liste automatisch
    auf oder Absteigend Sortieren (True/False als Parameter verwenden)-
    Beachtet allerdings, dass mit Sonderzeichen - in unserem Beispiel "ö" - nicht 
    ganz korrekt umgegangen wird.
endrem
Words.Sort()

For Local i:Int = 0 Until Words.Length ' Die Strings werden sortiert ausgegeben
    Print(Words[i])
Next

Print("")
Print("- - - - -")
Print("")

rem
    Einer TList kann man eine Funktion angeben, mit der zwei Einträge einer Liste
    verglichen werden soll.
endrem

'* Arrays in eine Liste übertragen:
Local WordListe:TList = ListFromArray(Words)

'* Liste Mittels der "SortStrings"-Funktion Sortieren
'* Achtung: Mit Klammern wird die Funktion ausgeführt, ohne Klammern wird die Referenz verwendet!
WordListe.Sort(True, SortStrings)

For Local s:String = EachIn WordListe ' Die Strings werden sortiert ausgegeben
    Print(s)
Next


End


Function SortStrings:Int(o1:Object, o2:Object)
    rem
        Eine Compare - Funktion vergleicht zwei Objekte, und gibt einen
        Wert zurück, um wieviel die Objekte in der Liste verschoben werden müssen.
        
        Als erstes Casten wir das allgemeine Objekt zurück zu einem String.
        Um das selbe ergebnis wie bei unser ursprünglichen Sortier-Funktion zu erhalten,
        verwenden wir kleinbuchstaben.
    endrem
    Local string1:String = Lower(String(o1))
    Local string2:String = Lower(String(o2))
    
    '* Jetzt kann ein Vergleich stattfinden
    Local i:Int, byte_1:Byte, byte_2:Byte
    
    '* Die Schleife wird so lange durchlaufen, bis jedes zeichen des kürzeren Strings abgearbeitet wurde.
    '* Min(v1, v2) liefert den kleineren zweier werte zurück.
    For i = 0 Until Min(string1.Length, string2.Length)
        byte_1 = string1[i]
        byte_2 = string2[i]
        ' Ist das Zeichen nicht gleich, geben wir die Differenz zurück:
        If byte_1 <> byte_2 Then Return(byte_1 - byte_2)
    Next
End Function
Win10 Prof.(x64)/Ubuntu 16.04|CPU 4x3Ghz (Intel i5-4590S)|RAM 8 GB|GeForce GTX 960
Wie man Fragen richtig stellt || "Es geht nicht" || Video-Tutorial: Sinus & Cosinus
THERE IS NO FAIR. THERE IS NO JUSTICE. THERE IS JUST ME. (Death, Discworld)
  • Zuletzt bearbeitet von Xeres am So, Feb 13, 2011 19:08, insgesamt einmal bearbeitet

BlitzMoritz

 BeitragDo, Feb 10, 2011 12:42
Antworten mit Zitat
Benutzer-Profile anzeigen
Tut mir leid - ich habe mir ein bisschen Zeit gegönnt - das Problem war schlichtweg zu spannend!
Darum bin ich jetzt so frei und erlaube mir, meine vier ganz unterschiedlichen Verfahren vorzustellen.

Vorab möchte ich noch kurz auf die Funktion "Wortliste_erstellen()" hinweisen, mit der eine Liste von beliebig vielen Worten aus einem vorgegebenen Alphabet zufällig erstellt wird. Diese "Worte" sind natürlich keine echten Worte mit Sinn, sondern rein zufällige Aneinanderreihungen von Buchstaben. Zweck der Funktion ist, die verschiedenen Sortierverfahren in hoher Anzahl und tatsächlich beliebiger Buchstabenkombination testen zu können, ohne dem Risiko ausgesetzt zu sein, durch ein paar wenige willkürlich festgelegte Beispielworte die Schnelligkeit und die Richtigkeit der Sortieralgorithmen nicht wirklich zu überprüfen.
Nun zu meinem ersten Verfahren:

Ich postete bereits, dass BlitzMax selbst mit der Klasse TList und ihrer Methode "SortList()" ein Verfahren zum Sortieren von Strings zur Verfügung stellt, welches allerdings für sich allein unseren deutsch-sprachigen Sortieransprüchen leider nicht genügt: Sämtliche Großbuchstaben werden a priori VOR alle Kleinbuchstaben eingeordnet: Es wird also "Zebra" VOR "aber" eingeordnet, was falsch ist. Auch die zahlreichen Sonderbuchstaben kommen gemäß ASCII-Nummern ganz hinten "nachgetröpfelt". Die Methode muss also ein bisschen modifiziert bzw. korrigiert werden, was auch ohne größeren Aufwand gelingt. Das dafür angewandte System ist denkbar einfach: Man nehme jedes Originalwort mit potentiellen Umlauten etc. und formatiere es so, dass es von SortList() korrekt sortiert wird. Formatieren bedeutet hier, alle Großbuchstaben in Kleinbuchstaben und die Sonderzeichen in einen (siehe unten) alphabetisch irgendwie logischen Ersatz zu verwandeln. Damit das unverfälschte Originalwort aber erhalten bleibt, hängt man es einfach, durch einen Trennstrich isoliert, an das formatierte Wort an und lässt per SortList() dieses "Doppelwort" sortieren. Für das Ergebnis schneidet man sich hernach nur noch das hintere Originalwort heraus. Vorraussetzung für das Gelingen ist natürlich, dass das hierfür benutzte Trennzeichen in keinem der Originalwörtern vorkommen darf. Normalerweise sollte so etwas wie "|" keine Probleme machen. Will man jedoch aus irgendwelchen Gründen ein anderes verwenden, kann man es einfach im zweiten optionalen Funktionsparameter der Sortier-Funktion definieren:

BlitzMax: [AUSKLAPPEN] 
Const Wortanzahl% = 2000

Function Wortliste_sortieren:TList(Liste:TList, Trennzeichen$ = "|")
	Local Doppelliste:TList = CreateList()
	For Local Originalwort$ = EachIn Liste
		Local FormatiertesWort$ = Lower(Originalwort)
		FormatiertesWort = Replace(FormatiertesWort, "ä", "ae")
		FormatiertesWort = Replace(FormatiertesWort, "ö", "oe")
		FormatiertesWort = Replace(FormatiertesWort, "ü", "ue")
		FormatiertesWort = Replace(FormatiertesWort, "ß", "ss")
		ListAddLast(Doppelliste, FormatiertesWort + Trennzeichen + Originalwort)
	Next
	SortList(Doppelliste)
	Local NeuSortierteListe:TList = CreateList()
	For Local DoppelWort$ = EachIn Doppelliste
		Local Trennstrichstelle% = Instr(DoppelWort, Trennzeichen)
		ListAddLast(NeuSortierteListe, Right(DoppelWort, Len(DoppelWort) - Trennstrichstelle))
	Next
	Return NeuSortierteListe	
End Function



'In folgender (den individuellen Wünschen leicht anzupassender) Zeichenkette
'definieren wir uns ein "Alphabet", welches als Buchstabenvorrat für unsere "Zufallswörter" gelten soll:
Const Alphabet$ = "0123456789aäbcdefghijklmnoöpqrsßtuüvwxyz"

Function Wortliste_erstellen:TList(WortAnzahl_insgesamt%)
	Local NeueWortliste:TList = CreateList()
	'Alles dem Zufall vorbehalten, zum Beispiel die Anzahl der Buchstaben, aus denen ein Wort besteht:
	Local Minimum_BuchstabenAnzahl_pro_Wort% = Rand(1,4)		'mindestens 1 bis 4 Buchstaben
	Local Maximum_BuchstabenAnzahl_pro_Wort% = Rand(5,30)	'maximal 5 bis 30 Buchstaben
	For Local w% = 1 To WortAnzahl_insgesamt
		Local NeuesWort$ 'ein lokales und darum jedesmal zunaechst komplett leeres Wort!
		For Local b% = 1 To Rand(Minimum_BuchstabenAnzahl_pro_Wort, Maximum_BuchstabenAnzahl_pro_Wort)
			'Es wird nun ein Buchstabe an den anderen gehaengt, zufaellig aus dem vorgegebenen Alphabet-Vorrat:
			Local Zufallsplatz:Int = Rand(1, Len(Alphabet))			
			Local Zufallsbuchstabe:String = Mid(Alphabet, Zufallsplatz, 1)
			If Asc(Zufallsbuchstabe) >= 97 And Asc(Zufallsbuchstabe) <= 122 Then '(zwischen a und z)
				'zu 33 % sollen auch Grossbuchstaben vorkommen (im vordefinierten Alphabet fehlen sie ja):
				If Rand(0,2) = 1 Then Zufallsbuchstabe = Chr(Asc(Zufallsbuchstabe)-32)
			End If
			NeuesWort = NeuesWort + Zufallsbuchstabe
		Next
		ListAddLast(NeueWortliste, NeuesWort)
	Next
	Return NeueWortliste
End Function

Function Wortliste_ausgeben(Liste:TList)
	For Local Wort$ = EachIn Liste
		Print Wort
	Next
	Print "======================================================="
End Function

'Jetzt der Testlauf:
Local Zufallswortliste:TList = Wortliste_erstellen(Wortanzahl)
Wortliste_ausgeben(Zufallswortliste)	'falls man die Wortliste ansehen will
Local Zeit:Int = MilliSecs()
Local SortierteListe:TList = Wortliste_sortieren(Zufallswortliste)
Zeit = (MilliSecs()-Zeit)
Wortliste_ausgeben(SortierteListe)	'falls man das Ergebnis kontrollieren will
Print "Das Sortieren der " + CountList(SortierteListe) + " Worte dauerte " + Zeit + " Millisekunden"


Nun hieß es ja, man solle sich seine eigene Gedanken machen, wie vorzugehen sei, ohne "SortList()" zu verwenden. Schließlich kommen ja unsere armen BlitzBasic-Freunde auch gar nicht in den Genuss dieses 'Service'. Wink
Basis aller meiner drei folgenden Verfahren ist ein konstanter Alphabet-String, der nicht nur den zur Verfügung stehenden Buchstaben-Vorrat darstellt, sondern durch seine Anordnung auch die gewünschte alphabetische Hierarchie, und der je nach Wunsch und Sprache individuell angepasst werden kann. Darauf aufbauend erstellte ich den globalen Array "Platz_im_Alphabet[]", mit dem ich später, ausgehend von der definierten Alphabet-Hierarchie, schneller entscheiden konnte, welcher Buchstabe gegen einen anderen "siegt". Weiterhin habe ich die Entscheidung, ob ein Wort alphabetisch vor dem anderen steht, also die Aufgabe, zwei Worte alphabetisch zu vergleichen, in einer Funktion mit dem Namen "Worte_vergleichen()" isoliert.

Für die Sortierfunktion selbst ist mir zunächst eine ganz einfache Idee eingefallen, deren Simplizität beinahe "lustig" wirkt, weil ich mich selbst um ein alphabetisches Einordnen gar nicht ernsthaft bemühe: Ich lasse lediglich jedes der Worte wie in einem großen Sportturnier genau einmal gegen jedes der anderen Worte "spielen" und notiere mir den Gewinner. Je häufiger ein Wort "gewonnen" hat, desto weiter vorne steht es im Alphabet. Am Ende weise ich jedem Wort direkt über seine Gewinnerpunktzahl die entsprechende Stelle in einem Array zu. Einen kleinen Haken hat die Sache aber doch noch: Was ist bei einem "Remis", wenn zwei Worte identisch sind? Vergäbe man dabei keine Punkte, bestünde die Gefahr, dass nicht alle Listen-Plätze vergeben sind, da mehrere Worte die gleiche Anzahl von SiegerPunkten besäßen. Dem kann man vorbeugen, indem man auch bei einem "Unentschieden" einen Punkt vergibt, und zwar stets nach dem gleichen System: Spielt in der Reihenfolge ein Wort gegen ein zweites Wort "Remis", so erhält per Definition das erste Wort den Gewinnerpunkt, basta.
Dieses Verfahren arbeitet tadelos, hat aber den Nachteil, dass es leider nicht besonders schnell ist, man kann den Aufwand leicht ausrechnen: Bei 10 Wörtern spielt das erste neunmal gegen die anderen, das zweite (das schon gegen das erste gespielt hat) spielt achtmal gegen die übrigen usw.
Am Ende erhält man 9 + 8 + 7 + 6 + 5 + 4 + 3 + 2 + 1 = 45
Es gleicht dem bekannten "Händeschütteln-Problem", allgemein sind es bei n Worten n * (n-1) / 2 Vergleiche. Der Rechenaufwand, jedem mit jedem zu vergleichen, benötigt bei 10.000 Wörtern 49.995.000 (also fast 50 Millionen) Wortvergleiche, auf meinem Rechner dauerte dieser Vorgang über 13 Sekunden.

BlitzMax: [AUSKLAPPEN] 
Const Wortanzahl% = 2000

'In folgender (den individuellen Wünschen leicht anzupassender) Zeichenkette
'definieren wir uns ein "Alphabet", welches als Buchstabenvorrat für unsere "Zufallswörter" gelten soll:
Const Alphabet$ = "0123456789aäbcdefghijklmnoöpqrsßtuüvwxyz"
Global Alphabet_Laenge% = Len(Alphabet)
'Um später im eigentlichen Sortierverfahren schneller entscheiden zu können, bilden wir ein Array,
Global Platz_im_Alphabet:Byte[256]
'in dem jede ASC-Nummer ihren Platz im definierten Alphabet zugewiesen bekommt,
'wobei wir durch "Lower()" bereits so ganz nebenbei auch die Großbuchstaben integrieren:
For Local ASCII:Byte = 0 Until 255
	Platz_im_Alphabet[ASCII] = Instr(Alphabet, Lower(Chr(ASCII)))
	If Platz_im_Alphabet[ASCII] = 0 Then Platz_im_Alphabet[ASCII] =  Alphabet_Laenge+1
								'falls im Alphabet wider Erwarten nicht vorhanden: ganz ans Ende rücken!
Next


Function Worte_vergleichen:Byte(Wort_0$, Wort_1$) 'gibt 0 zurück, wenn das erste Wort alphabetisch VOR dem zweiten steht, ansonsten 1
	For Local b% = 1 To Len(Wort_0$)	 ''Nun werden die beiden Worte Buchstabe für Buchstabe verglichen:
		If Len(Wort_1$) < b Then Return 0
		Local Buchstabe_0_ASCII_Nr% = Asc(Mid(Wort_0, b, 1))
		Local Buchstabe_1_ASCII_Nr% = Asc(Mid(Wort_1, b, 1))
		'Dank unseres Alphabet-Plätze können wir jetzt sehr schnell entscheiden:
		If Platz_im_Alphabet[Buchstabe_0_ASCII_Nr] > Platz_im_Alphabet[Buchstabe_1_ASCII_Nr] Then
			Return 0	 'das erste Wort steht VOR dem zweiten
		ElseIf Platz_im_Alphabet[Buchstabe_0_ASCII_Nr] < Platz_im_Alphabet[Buchstabe_1_ASCII_Nr] Then
			Return 1	 'das erste Wort steht NACH dem zweiten
		End If
		'falls die Buchstaben beider Worte den gleichen Platz im Alphabet einnehmen, muss weiter verglichen werden:
	Next	 'Schreiten wir in der Schleife also zum nächsten Buchstaben!
	Return 1
End Function

Function Wortliste_sortieren:TList(Liste:TList)
	Local Array:Object[] = ListToArray(Liste)
	Local SiegerPunkte%[Len(Array)]
	'Gehen wir jedes Wort in der Array-Liste durch:
	For Local i% = 0 Until Len(Array)	 '(im Gegensatz zu "For - To" bricht die "For - Until"-Schleife einen Durchgang früher ab!)
		'Es beginnt immer mit dem nächsten Array-Eintrag von i, denn vorangehende Paarungen wurden bereits verglichen
		For Local j% = i+1 Until Len(Array)
			If Worte_vergleichen(String(Array[i]), String(Array[j])) = 0 Then
				SiegerPunkte[i] = SiegerPunkte[i] + 1
			Else
				SiegerPunkte[j] = SiegerPunkte[j] + 1
			End If
		Next
	Next
	'Nun bilden wir ein "Gewinner-Array" als sortierte Wortliste
	Local Gewinner$[Len(Array)]
	'und ordnen die Einträge nach den SiegerPunkten zu:
	For Local v% = 0 Until Len(Array)
		Gewinner[SiegerPunkte[v]] = String(Array[v])
	Next
	Return ListFromArray(Gewinner)
End Function

Function Wortliste_erstellen:TList(WortAnzahl_insgesamt%)
	Local NeueWortliste:TList = CreateList()
	'Alles dem Zufall vorbehalten, zum Beispiel die Anzahl der Buchstaben, aus denen ein Wort besteht:
	Local Minimum_BuchstabenAnzahl_pro_Wort% = Rand(1,4)		'mindestens 1 bis 4 Buchstaben
	Local Maximum_BuchstabenAnzahl_pro_Wort% = Rand(5,30)	'maximal 5 bis 30 Buchstaben
	For Local w% = 1 To WortAnzahl_insgesamt
		Local NeuesWort$ 'ein lokales und darum jedesmal zunaechst komplett leeres Wort!
		For Local b% = 1 To Rand(Minimum_BuchstabenAnzahl_pro_Wort, Maximum_BuchstabenAnzahl_pro_Wort)
			'Es wird nun ein Buchstabe an den anderen gehaengt, zufaellig aus dem vorgegebenen Alphabet-Vorrat:
			Local Zufallsplatz:Int = Rand(1, Len(Alphabet))			
			Local Zufallsbuchstabe:String = Mid(Alphabet, Zufallsplatz, 1)
			If Asc(Zufallsbuchstabe) >= 97 And Asc(Zufallsbuchstabe) <= 122 Then '(zwischen a und z)
				'zu 33 % sollen auch Grossbuchstaben vorkommen (im vordefinierten Alphabet fehlen sie ja):
				If Rand(0,2) = 1 Then Zufallsbuchstabe = Chr(Asc(Zufallsbuchstabe)-32)
			End If
			NeuesWort = NeuesWort + Zufallsbuchstabe
		Next
		ListAddLast(NeueWortliste, NeuesWort)
	Next
	Return NeueWortliste
End Function

Function Wortliste_ausgeben(Liste:TList)
	For Local Wort$ = EachIn Liste
		Print Wort
	Next
	Print "======================================================="
End Function

'Jetzt der Testlauf:
Local Zufallswortliste:TList = Wortliste_erstellen(Wortanzahl)
Wortliste_ausgeben(Zufallswortliste)	'falls man die Wortliste ansehen will
Local Zeit:Int = MilliSecs()
Local SortierteListe:TList = Wortliste_sortieren(Zufallswortliste)
Zeit = (MilliSecs()-Zeit)
Wortliste_ausgeben(SortierteListe)	'falls man das Ergebnis kontrollieren will
Print "Das Sortieren der " + CountList(SortierteListe) + " Worte dauerte " + Zeit + " Millisekunden"


Bei meinem dritten Verfahren versuchte ich, effektiver zu sortieren und v.a. zu vermeiden, dass tatsächlich jedes Wort wie beim vorigen Verfahren gegen jedes andere antreten muss. Denn wenn man schon einen Teil der Wörter richtig sortiert hat, genügt es doch, für das noch unsortierte Wort lediglich die richtigen Stelle für das Einordnen zu finden. Diese Stelle könnte ja eventuell ganz in der Nähe der ursprünglichen Wortposition liegen. Mit der Laufvariablen w läuft meine dritte Sortiert-Funktion also Wort für Wort durch das Wort-Array. Und falls sie (mit der Worte_vergleichen()-Funktion) auf ein unpassendes neues Wort trifft, läuft dieses mit einer zweiten Laufvariabeln in der bereits sortierten Teilliste wieder so weit zurück, bis es an der richtigen Stelle einrastet:

BlitzMax: [AUSKLAPPEN] 
Const Wortanzahl% = 2000

Function Wortliste_sortieren:TList(Liste:TList)
	Local Array:Object[] = ListToArray(Liste)
	Local w% = 1 	 'ein Index, stellvertretend fuer jenes Wort, bis zum dem die Liste bereits "vorsortiert" ist
	While w < Len(Array)  'nun gilt es, alle Worte abzuarbeiten
		While w < Len(Array) 'nun solange die Liste durchgehen, bis man auf ein Wort trifft,
			If Worte_vergleichen(String(Array[w]), String(Array[w-1])) = 1 Then Exit	 'welches "vorher" einsortiert werden muesste!
			w = w+1
		Wend
		If w = Len(Array) Then Exit 'falls wir bei diesem Vergleich schon am Ende der Liste angekommen sind, sind wir ganz fertig!
		'ansonsten muessen wir alle bisher einsortierten Wörter "nach vorne" schieben und das Wort "irgendwo früher" einsortieren!
		Local MemoWort$ = String(Array[w])  'zunächst merken wir uns dieses Wort in einer separaten Variablen,
		Array[w] = Array[w-1]	 ''weil hier der entsprechende Arrayeintrag durch das Vorschieben "ueberschrieben" wird
		'Nun lassen wir dieses separierte Wort in der Reihenfolge des bereits sortierten
		'Array-Abschnitts wie eine Luftblase so lange wieder "hoch-blubbern",  bis es "einrastet":
		Local w_Ruecklauf% = w-1		'separate Laufvariable fuer den "Rueckweg"
		While w_Ruecklauf > 0
			Array[w_Ruecklauf] = Array[w_Ruecklauf-1]	 'alle Worte um eins nach vorne schieben ...
			If Worte_vergleichen( String(Array[w_Ruecklauf]), MemoWort)  = 1 Then Exit	'bis das Alphabet wieder stimmt
			w_Ruecklauf = w_Ruecklauf - 1
		Wend
		Array[w_Ruecklauf] = MemoWort  'jetzt den leer gewordenen (bzw. eigentlich doppelt besetzten) Platz füllen
		'wir sind im sortierten Listenabschnitt einen Schritt weitergekommen und gehen daher weiter ...
		w = w + 1	  'zum nächsten Wort des (noch unsortieren) Array-Abschnitts
	Wend
	Return ListFromArray(Array)
End Function



'Ab hier kommt jetzt nichts Neues mehr:

'In folgender (den individuellen Wünschen leicht anzupassender) Zeichenkette
'definieren wir uns ein "Alphabet", welches als Buchstabenvorrat für unsere "Zufallswörter" gelten soll:
Const Alphabet$ = "0123456789aäbcdefghijklmnoöpqrsßtuüvwxyz"
Global Alphabet_Laenge% = Len(Alphabet)
'Um später im eigentlichen Sortierverfahren schneller entscheiden zu können, bilden wir ein Array,
Global Platz_im_Alphabet:Byte[256]
'in dem jede ASC-Nummer ihren Platz im definierten Alphabet zugewiesen bekommt,
'wobei wir durch "Lower()" bereits so ganz nebenbei auch die Großbuchstaben integrieren:
For Local ASCII:Byte = 0 Until 255
	Platz_im_Alphabet[ASCII] = Instr(Alphabet, Lower(Chr(ASCII)))
	If Platz_im_Alphabet[ASCII] = 0 Then Platz_im_Alphabet[ASCII] =  Alphabet_Laenge+1
								'falls im Alphabet wider Erwarten nicht vorhanden: ganz ans Ende rücken!
Next

Function Worte_vergleichen:Byte(Wort_0$, Wort_1$) 'gibt 0 zurück, wenn das erste Wort alphabetisch VOR dem zweiten steht, ansonsten 1
	For Local b% = 1 To Len(Wort_0$)	 ''Nun werden die beiden Worte Buchstabe für Buchstabe verglichen:
		If Len(Wort_1$) < b Then Return 0
		Local Buchstabe_0_ASCII_Nr% = Asc(Mid(Wort_0, b, 1))
		Local Buchstabe_1_ASCII_Nr% = Asc(Mid(Wort_1, b, 1))
		'Dank unseres Alphabet-Plätze können wir jetzt sehr schnell entscheiden:
		If Platz_im_Alphabet[Buchstabe_0_ASCII_Nr] > Platz_im_Alphabet[Buchstabe_1_ASCII_Nr] Then
			Return 0	 'das erste Wort steht VOR dem zweiten
		ElseIf Platz_im_Alphabet[Buchstabe_0_ASCII_Nr] < Platz_im_Alphabet[Buchstabe_1_ASCII_Nr] Then
			Return 1	 'das erste Wort steht NACH dem zweiten
		End If
		'falls die Buchstaben beider Worte den gleichen Platz im Alphabet einnehmen, muss weiter verglichen werden:
	Next	 'Schreiten wir in der Schleife also zum nächsten Buchstaben!
	Return 1
End Function

Function Wortliste_erstellen:TList(WortAnzahl_insgesamt%)
	Local NeueWortliste:TList = CreateList()
	'Alles dem Zufall vorbehalten, zum Beispiel die Anzahl der Buchstaben, aus denen ein Wort besteht:
	Local Minimum_BuchstabenAnzahl_pro_Wort% = Rand(1,4)		'mindestens 1 bis 4 Buchstaben
	Local Maximum_BuchstabenAnzahl_pro_Wort% = Rand(5,30)	'maximal 5 bis 30 Buchstaben
	For Local w% = 1 To WortAnzahl_insgesamt
		Local NeuesWort$ 'ein lokales und darum jedesmal zunaechst komplett leeres Wort!
		For Local b% = 1 To Rand(Minimum_BuchstabenAnzahl_pro_Wort, Maximum_BuchstabenAnzahl_pro_Wort)
			'Es wird nun ein Buchstabe an den anderen gehaengt, zufaellig aus dem vorgegebenen Alphabet-Vorrat:
			Local Zufallsplatz:Int = Rand(1, Len(Alphabet))			
			Local Zufallsbuchstabe:String = Mid(Alphabet, Zufallsplatz, 1)
			If Asc(Zufallsbuchstabe) >= 97 And Asc(Zufallsbuchstabe) <= 122 Then '(zwischen a und z)
				'zu 33 % sollen auch Grossbuchstaben vorkommen (im vordefinierten Alphabet fehlen sie ja):
				If Rand(0,2) = 1 Then Zufallsbuchstabe = Chr(Asc(Zufallsbuchstabe)-32)
			End If
			NeuesWort = NeuesWort + Zufallsbuchstabe
		Next
		ListAddLast(NeueWortliste, NeuesWort)
	Next
	Return NeueWortliste
End Function

Function Wortliste_ausgeben(Liste:TList)
	For Local Wort$ = EachIn Liste
		Print Wort
	Next
	Print "======================================================="
End Function

'Jetzt der Testlauf:
Local Zufallswortliste:TList = Wortliste_erstellen(Wortanzahl)
Wortliste_ausgeben(Zufallswortliste)	'falls man die Wortliste ansehen will
Local Zeit:Int = MilliSecs()
Local SortierteListe:TList = Wortliste_sortieren(Zufallswortliste)
Zeit = (MilliSecs()-Zeit)
Wortliste_ausgeben(SortierteListe)	'falls man das Ergebnis kontrollieren will
Print "Das Sortieren der " + CountList(SortierteListe) + " Worte dauerte " + Zeit + " Millisekunden"


Erweist sich mein drittes Sortierverfahren schon mehr als doppel so schnell wie das zweite, so ist die Geschwindigkeit gegenüber der modifizierten SortList()-Methode leider immer noch enttäuschend langsam: Für 10.000 Wörter benötigte mein Rechner gut sechs Sekunden. Darum hat mich noch einmal der Ehrgeiz gepackt, ein wirklich schnelleres Sortierverfahren zu finden. Da ich vermutete, dass der Geschwindigkeitsverlust meiner vorigen Methode mitunter darin begründet ist, dass ich ein ums andere Mal, immer und immer wieder einzelne Wörter Schritt für Schritt die ganze Wortliste nach oben und unten umsortiere, bis sie endlich einrasten, fragte ich mich: Wie kann man dieses elende Umschichten generell vermeiden?
Meine viertes Verfahren hat daher einen ganz anderen Ansatz: Statt die Bücher auf einem einzigen riesigen Stapel hin- und herzuschichten, verteile ich sie einfach von vorneherein in ein großes Regal aus vielen separat nummerierten Schubfächern, die wiederum selbst beliebig viele tiefere Schubfächer besitzen. Am Ende sammle ich dann nur noch die kompletten Bücherstapel der einzelnen Fächer in der richtigen Reihenfolge zusammen. Die Effektivität besteht darin, dass jeder Buchstabe jedes Wortes höchstens ein einziges Mal mit Asc(Mid(,,)) eingelesen werden muss. Wie geht das?
Die Schubfächer sind bei mir lokale Arrays aus Listen, mit denen eine rekursive, also sich selbst aufrufende Funktion jongliert. Voila - das Ergebnis zufriedenstellend: 100.000 Wörter in weniger als einer Sekunde.
BlitzMax: [AUSKLAPPEN] 
Const Wortanzahl% = 2000

Function Wortliste_sortieren:TList(Liste:TList, Iteration:Int = 1)	 'Iteration bedeutet die Position des Buchstabens im Wort
	Local Wort$, Liste_pro_Buchstabe:TList[Alphabet_Laenge+2] 'für jeden Alphabetbuchstaben eine lokale Liste als "Schubfach"
	For Local LpB:Byte = 0 To Alphabet_Laenge+1
		Liste_pro_Buchstabe[LpB] = CreateList()
	Next
	For Wort = EachIn Liste
		If Len(Wort) < Iteration Then 'falls das Wort VOR der Buchstabenposition "Iteration" schon zu Ende ist
			ListAddLast(Liste_pro_Buchstabe[0], Wort)
		Else		 'falls nicht, Einordnung des Wortes in das entsprechende "Alphabet-Schubfach":
			ListAddLast(Liste_pro_Buchstabe[Platz_im_Alphabet[ Asc(Mid(Wort, Iteration, 1))]], Wort)
		End If
	Next	
	Local NeuSortierteListe:TList = CreateList() 'diese "Sammelliste" wird später als sortierte Liste zurückgegeben
	'Erst werden darin alle bereits vorher fertigen Wörter ...
	For Wort = EachIn Liste_pro_Buchstabe[0]
		ListAddLast(NeuSortierteListe, Wort)
	Next
	'... und dann die noch vakanten Alphabetschubfächer in der richtigen Reihenfolge aufgesammelt:
	For Local b:Byte = 1 To Alphabet_Laenge + 1
		'falls es mehrere "in einem Schubfach" gibt, diese per rekursivem Funktionsaufruf mit nächster Buchstabenposition weitersortieren:
		If CountList(Liste_pro_Buchstabe[b]) > 1 Then Liste_pro_Buchstabe[b] = Wortliste_sortieren(Liste_pro_Buchstabe[b], Iteration+1)
		For Wort = EachIn Liste_pro_Buchstabe[b]
			ListAddLast(NeuSortierteListe, Wort)	'am Ende alle Wörter der einzelnen Schubfächer aufsammeln.
		Next				
	Next
	Return NeuSortierteListe	
End Function



'Ab hier kommt nichts Neues:

'In folgender (den individuellen Wünschen leicht anzupassender) Zeichenkette
'definieren wir uns ein "Alphabet", welches als Maßstab gelten soll:
Const Alphabet$ = "0123456789aäbcdefghijklmnoöpqrsßtuüvwxyz"
'Üblicherweise kommen die Ziffern zu Beginn, die Umlaute folgen den originalen Vokalen und das ß auf das s.
Global Alphabet_Laenge% = Len(Alphabet)
'Um später im eigentlichen Sortierverfahren schneller entscheiden zu können, bilden wir ein Array,
Global Platz_im_Alphabet:Byte[256]
'in dem jede ASC-Nummer ihren Platz im definierten Alphabet zugewiesen bekommt,
'wobei wir durch "Lower()" bereits so ganz nebenbei auch die Großbuchstaben integrieren:
For Local ASCII:Byte = 0 Until 255
	Platz_im_Alphabet[ASCII] = Instr(Alphabet, Lower(Chr(ASCII)))
	If Platz_im_Alphabet[ASCII] = 0 Then Platz_im_Alphabet[ASCII] =  Alphabet_Laenge+1
								'falls im Alphabet wider Erwarten nicht vorhanden: ganz ans Ende rücken!
Next

Function Wortliste_erstellen:TList(WortAnzahl_insgesamt%)
	Local NeueWortliste:TList = CreateList()
	'Alles dem Zufall vorbehalten, zum Beispiel die Anzahl der Buchstaben, aus denen ein Wort besteht:
	Local Minimum_BuchstabenAnzahl_pro_Wort% = Rand(1,4)		'mindestens 1 bis 4 Buchstaben
	Local Maximum_BuchstabenAnzahl_pro_Wort% = Rand(5,30)	'maximal 5 bis 30 Buchstaben
	For Local w% = 1 To WortAnzahl_insgesamt
		Local NeuesWort$ 'ein lokales und darum jedesmal zunaechst komplett leeres Wort!
		For Local b% = 1 To Rand(Minimum_BuchstabenAnzahl_pro_Wort, Maximum_BuchstabenAnzahl_pro_Wort)
			'Es wird nun ein Buchstabe an den anderen gehaengt, zufaellig aus dem vorgegebenen Alphabet-Vorrat:
			Local Zufallsplatz:Int = Rand(1, Len(Alphabet))			
			Local Zufallsbuchstabe:String = Mid(Alphabet, Zufallsplatz, 1)
			If Asc(Zufallsbuchstabe) >= 97 And Asc(Zufallsbuchstabe) <= 122 Then '(zwischen a und z)
				'zu 33 % sollen auch Grossbuchstaben vorkommen (im vordefinierten Alphabet fehlen sie ja):
				If Rand(0,2) = 1 Then Zufallsbuchstabe = Chr(Asc(Zufallsbuchstabe)-32)
			End If
			NeuesWort = NeuesWort + Zufallsbuchstabe
		Next
		ListAddLast(NeueWortliste, NeuesWort)
	Next
	Return NeueWortliste
End Function

Function Wortliste_ausgeben(Liste:TList)
	For Local Wort$ = EachIn Liste
		Print Wort
	Next
	Print "======================================================="
End Function

'Jetzt der Testlauf:
Local Zufallswortliste:TList = Wortliste_erstellen(Wortanzahl)
Wortliste_ausgeben(Zufallswortliste)	'falls man die Wortliste ansehen will
Local Zeit:Int = MilliSecs()
Local SortierteListe:TList = Wortliste_sortieren(Zufallswortliste)
Zeit = (MilliSecs()-Zeit)
Wortliste_ausgeben(SortierteListe)	'falls man das Ergebnis kontrollieren will
Print "Das Sortieren der " + CountList(SortierteListe) + " Worte dauerte " + Zeit + " Millisekunden"

Ana

 BeitragDo, Feb 10, 2011 13:12
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich hab mich (größtenteils) gegen die Tlist/Tmap entschieden, schien mir die eigentliche Aufgabe zu verfehlen, da ich dabei ja kaum sortieren müsste. Deshalb hab ich selbst einen Binärbaum, erstellt und ordne die Wörter entsprechend des Alphabets in ihm an. Danach wird er in der "inorder" - Reihenfolge traversiert und als Liste zurückgegeben.

BlitzMax: [AUSKLAPPEN] 
Rem Ana__COMMENT1__
	Blade zur liebe diesmal sogar mit Superstrict Wink
	
	Das Ganze wird zunächst in einem Binärbaum gespeichert und per Inorderverfahren wieder gegeben.
	Ich hab mich hier für Types anstatt Arrays entschieden, was mehr Sympathie- als Laufzeitgründe hat.
	In einem Array bäruchte es nicht die v/n einteilung, sondern könnte mit 2n und 2n+1 gemacht werden.
	Die Strings werden in dem Typ AnaWord unter gebracht, und ja ich bin selbst verliebt ;-P
End Rem
SuperStrict

Type AnaWord
	Field t:String
	Field n:Anaword
	Field v:Anaword
	
	Method Vergleich%(T:Anaword,Pos:Int)
		If t.t = Self.t Then Return -1		'Texte die gleich sind kommen nach vorne
		If Len(t.t) < pos Then Return 1		'Falls t kürzer ist kommt es nach vorne
		If Len(Self.t) < pos Then Return -1	'Falls t länger ist kommt es nach hinten
		Local SelfT:Int = Asc(Lower(Mid(Self.t,pos,1)))		
		Local CompT:Int = Asc(Lower(Mid(T.t,pos,1)))
		
		If selft < compt Then Return -1
		If selft > compt Then Return 1
		Return Vergleich(t,pos +1)
	End Method
	
	Method Add%(W:AnaWord) ' Methode die die Wurzel will und dann in den Baum einordnet
		Local relation:Int = Vergleich(w,1)
		
		If relation = -1 Then
			If n = Null 
				n = w
			Else
				n.add(w)
			EndIf
		Else
			If v = Null
				v = w
			Else
				v.add(w)
			EndIf
		EndIf
	End Method
	
	Method Inorder:TList()
	 	Local List:TList = New TList
		inorder_in(list)
		Return list
	End Method
				
	Method Inorder_in(l:TList)
		If n <> Null Then n.inorder_in(l)
		ListAddFirst(l,Self)
		If v <> Null Then v.inorder_in(l)
		Return 
	End Method



End Type

Function Create_AnaWord:Anaword(t:String,AddWord:Anaword = Null)
	Local A:Anaword = New AnaWord
		a.t = t
		If addword <> Null Then addword.add(a)
	Return a
End Function
Local w:Anaword = Create_AnaWord("Erster")
Create_AnaWord("Erster Satz",w)
Create_AnaWord("Dritter",w)
Create_AnaWord("Vierter",w)
Create_AnaWord("Fünfter",w)
Print_BST(w.Inorder())


Function Print_BST(L:TList)
	Local a:Anaword
	For A = EachIn l
		Print a.t
	Next
End Function
Don't only practice your art,
but force your way into its secrets,
for it and knowledge
can raise human to divine

Xeres

Moderator

BeitragSo, Feb 13, 2011 19:12
Antworten mit Zitat
Benutzer-Profile anzeigen
Danke für eure Teilnahme und speziell an BlitzMoritz für den Essay artigen Beitrag!

Die Musterlösungen finden sich im Eingangspost.
Win10 Prof.(x64)/Ubuntu 16.04|CPU 4x3Ghz (Intel i5-4590S)|RAM 8 GB|GeForce GTX 960
Wie man Fragen richtig stellt || "Es geht nicht" || Video-Tutorial: Sinus & Cosinus
THERE IS NO FAIR. THERE IS NO JUSTICE. THERE IS JUST ME. (Death, Discworld)

Neue Antwort erstellen


Übersicht BlitzMax, BlitzMax NG Beginners-Corner

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group