Geschrieben von: Bernhard Spuida
Kategorie: Tee Off
This printed page brought to you by AlphaSierraPapa
Nach dem Erfolg des ersten ASP Golfturniers ging es mit folgender Aufgabenstellung in die zweite Runde: Eine Wortliste ist gegeben. Alle in ihr vorkommenden Anagramme sollen gruppiert werden. Anagramgruppen werden im Beispiel zur Verdeutlichung durch einen Strich voneinander abgetrennt. Groß/Kleinschreibung muß nicht berücksichtigt werden. Die Übergabe an das Testskript folgt der im ersten Minigolf - d.h. keine eigenen Leseroutinen in das Golfskript einbauen, wird vom Testskript gemacht.
Beispiel Eingabe:
alle albern Albert deren ella elle elise else gerne green lagen leise
nagel nager neger neiger Reden regen reggae reigen
Liefert als Ergebnis:
gerne green neger regen | alle ella | deren reden | elise leise | lagen
nagel | neiger reigen | albern | albert | elle | else | nager | reggae
Die eigentliche Wortliste ist natürlich länger. Sortierung ist nicht notwendig. Dubletten werden nicht auftreten. Die Eingabe und Ausgabe der Werte erfolgt über ein Array mit einem Wort pro Element als Input, ein Array of Arrays als Output, wobei die Subarrays jeweils einer Anagrammgruppe entsprechen. Die Trennstriche aus dem obigen Beispiel sind *nicht* mitzuübergeben, sie dienen nur zur besseren Darstellung im Beispiel!
Input:
Application("input")=Array("alle","albern","Albert",...,"reigen")
Output:
Application("output")=Array( Array("gerne","green","neger","regen"),
Array("alle","ella"), ... )
Die Testliste ist entnommen aus http://download.sourceforge.net/wordlist/12dicts-3.0.zip Es handelt sich um eine Untermenge der Worte in der Datei 6of12.txt. Für eigene Tests kann jeder sich die entsprechenden Dateien selbst holen. Zu beachten ist, daß die Worte nur aus a-z bestehen und keine Sonder- oder Leerzeichen enthalten, ebenso keine Umlaute.
Die Herausforderung wurde mit Begeisterung angenommen. Erfreulich war auch, daß einige neue Golfer dazukamen. Herzlich willkommen am Platz!
Nun zum Leaderboard (Details):
Im Bunker landeten trotz verzweifelter Schaufelaktivitäten: Thorsten Eiben und Michael Guder. Kopf hoch - nächstes Mal wirds wieder. Keep on Golfing!
Das Turnier war spannend vom Anfang bis zum Ende: die erste gültige Lösung lag bei 446 Schlägen, bis zum Turnierende wurde die Aufgabe bis auf 221 Schläge heruntergegolft. Eine beachtliche Leistung! Es gab auch zwischenzeitlich Tie-breaks, die zu weiteren übermenschlichen Anstrengungen führten.
In diesem Turnier wurde auch eine Neuerung eingeführt: ein Online-Golfplatz wo die Spieler ihre Lösungen automatisch an die Schiedsrichter einreichen können und ein Leaderboard zur Verfügung steht. Der Tester wurde auch dieses mal wieder von Claudius Ceteras programmiert - herzlichen Dank, Claudius! Insgesamt kamen sechs verschiedene Testdatensätze zum Einsatz um verschiedene Algorithmen auszuscheiden die prinzipbedingt unvollständige Lösungen erzeugen.
Genug der Vorrede, auf zum Abschlag: da es dieses mal einige interessante Ansätze gab, die leider nicht auf den vorderen Plätzen landeten, werden wir dieses mal nicht die ersten drei Plätze betrachten.
Thorsten blieb zwar im Bunker hängen, aber sein Ansatz verdient Beachtung. In seinen Worten:
Hallo Sportsfreunde:
Hier zur allgemeinen Erheiterung mein bester Bunkerversuch. Sicherlich nicht geeignet, um zukünftigen Golfern den Weg zu zeigen, aber immerhin ein anderer Ansatz und vielleicht kann mich ja mal jemand aufklären warum der Abschlag im Sand landete.
<%set z=Application:a=z("Input")
for each c in a:v=len(c)
if v>0then
s=c
for j=0 to ubound(a)
h=a(j)
if v=len(h) and strComp(c,h)<>0then
for q=1 to len(c)
r=mid(c,q,1):h=replace(h,r,"",1,1):next
if len(h)=0 then s=s+","+a(j):a(j)=""
end if:next:u=u+s+" "
end if:next:o=split(u)
for p=0 to ubound(o):o(p)=split(o(p),","):next
z("Output")=o
%>
Die Idee war beim zu testenden Wort den jeweils aktuellen Buchstaben durch ein Leerzeichen zu ersetzen - falls am Ende ein leerer String rauskommt ist's ein Anagramm. Vom Hashalgo hatte ich mich nach Claudius Warnung verabschiedet. Hätte man mit dem Dictionary-Ansatz auch bestimmt noch unter 300 schrumpfen können...
Anmerkungen dazu: Die Bemerkung mit den Hashes bezieht sich darauf daß multiplikative und additive Hashes unvollständige Lösungen liefern. Der Fehler war letzten Endes ein leeres Element am Ende des Arrays. Außerdem lassen sich hier und da ein paar Bytes sparen wenn man die Techniken anwendet, die im Tee Off! des ersten Turniers vorgestellt wurden und auch in der nächsten vorgestellten Lösung verwendet werden (Tip: For-Schleifen näher anschauen). Trotz Bunkerlandung ein interessanter Ansatz. Keep on golfing, Thorsten!
Andreas kam leider nicht sonderlich weit nach vorne, aber seine letztgültige Lösung kommt den ursprünglichen Vorstellungen der Schiris recht nahe - sowohl was Ansatz als auch Länge betrifft, außerdem stellt er auch noch einige andere Lösungsversuche vor, die auch andere Spieler verwendeten, daher werden seine Lösungen stellvertretend präsentiert:
<%Set V=Application
A=V("input")
Set w=CreateObject("scripting.dictionary")
'(1)
For B=0To Ubound(A)
E=A(B)
'(2)
For C=9To 122
For D=1To len(E)
If c=asc(mid(e,d))Then Z=Z&chr(c)
Next
Next
'(3)
w(Z)=w(Z)&" "&E
Z=""
Next
'(4)
For Each K in w.keys
W(K)=Split(trim(W(K)))
Next
('5)
V("output")=w.Items%>
Eigentlich auf Anregungen aus einem Gespräch mit Alex Veit programmiert. Das ganze ist sehr einfach zu verstehen. Ein Scripting Dictionary wird instanziert, dann alle Inhalte einmal in einer Schleife durchgegangen (1), wobei jeweils ein String erzeugt wird, in dem die Buchstaben sortiert sind (2). Der wird als Schlüssel genommen und der Prüfling dem Dictionary Eintrag mit diesem Schlüssel zugewiesen(3). Anschließend werden die Dictionary Einträge noch mit Split zu einem Array umgewandelt (4). Die Dictionary Eigenschaft Items gibt dann das gewünschte Array an Output weiter (5).
Die Stringverkettung und anschließende Umwandlung sowie weitere kleine Tricks sind beim letzten Golf gut beschrieben worden. Nach der Einsendung dieses Scripts letzten Donnerstag konnte ich mich leider zeitlich nicht mehr dem Golf widmen.
Hier möchte ich noch ein paar von den ersten Versuchen zeigen, die ja vielleicht auch ganz interessant sind. Hier mein erster (funktionierender) Ansatz:
<%Set V=Application
A=V("input")
G=vbCr
H=Ubound(A)
O=""""
'(1)
P="Array("
For B=0To H
C=A(B)
If C<>G Then
Z=Z&","&P&O&C
A(B)=G
For I=0To H
J=A(I)
N=Len(C)
Q=Len(J)
If J<>G AND N=Q Then
K=C
M=0
For D=1To Q
'(2)
L=instr(K,mid(J,D,1))
If L<>0 Then K=mid(K,1,L-1)&mid(K,L+1):M=M+1
Next
'(zu 1)
If M=N Then Z=Z&""","""&J:A(I)=G
End If
Next
'(zu 1)
Z=Z&""")"
End If
Next
'(Zu 1)
Execute "V(""output"")="&P&mid(Z,2)&")"%>
(1): Ich baue das Array im Array als Befehlsstring auf, den ich erst am Ende mit dem Execute Befehl ausführe zB: Execute "V(""output"")=Array(Array("aae",aea"),Array(""abb"",""bab""))" (2): Ich habe 2 Schleifen die den Code durchgehen. Wird in der ersten Schleife ein Wort erreicht, das noch nicht getestet wurde, wechselt es in die 2. Schleife. Dort wird das Wort in einen String kopiert und jedes, nicht als gebraucht markierte Wort wird verglichen, indem aus dem kopierten String jeder gefundene Buchstabe entfernt wird. Ist der String anschließend leer und die Worte waren gleich lang, handelt es sich um ein Anagramm. Benutzte Worte werden markiert, indem ihnen Buchstabe O zugewiesen wird.
Da hier insbesondere die Erzeugung der Arrays viel Raum einnimmt, hab ichs doch mal mit einer klassischen Variante versucht (hier mit zu ungenauem Hashalgo bei (1), der wie ich mittlerweile weiß, mit ^4 funktioniert hätte):
<%Set V=Application
A=V("input")
H=Ubound(A)
O=" "
For B=0To H
C=A(B)
If C<>O Then
For I=0To H
J=A(I)
N=Len(C)
If N=Len(J) Then
K=0
L=0
'(1)
For D=1To N
L=L+asc(mid(J,D))^2
K=K+asc(mid(C,D))^2
Next
If L=K Then Z=Z&O&J:A(I)=O
End If
Next
'(2)
Redim Preserve Y(U)
Y(U)=split(trim(Z))
U=U+1
Z=O
End If
Next
V("output")=Y%>
(1) Zählt die quadrierten Ascii Codes zusammen, um somit einen Vergleichswert bei gleichen Buchstaben eines Strings zu erhalten. (2) Hier vergrößere ich das spätere Ausgabe-Array immer wieder mit Redim Preserve.
Das hätte dann meine funktionierende Eingabe sein können, wenn ich nicht wegen Claudius Ausschluß von addierenden Hashes diesen Weg aufgegeben hätte.
Anmerkungen: Ein wunderbares Beispiel für Evolution am Werk. Was die selbst geschnitzten Hashes angeht, so finden sich bei den meisten Ansätzen in diesem Turnier Schwachpunkte, die Erklärung stammt von Alexander Veit:
Das Problem bei diesen arithmetischen Hashes erklärt sich einfach mit Hilfe des Schubfach-Prinzips: Der Werteraum der Zahldatentypen in VB ist endlich, es gibt aber unendlich viele Strings. Also werden mehrere Strings auf denselben Hash abgebildet. Das Problem hätte man nicht, wenn es in VB Arithmetik mit beliebiger Genauigkeit gäbe. Dann könnte man z.B. eine Zahl N finden sodaß:
function hash(s)
hash = 1
for i = 1 to len(s)
hash = hash * (N + asc(mid(s, i)))
next
end function
genau für Anagramme denselben Wert hätte.
Danke, Alex!
Wie wir gleich am Beispiel von Markus sehen werden, ist auch kreative Fehlerbehandlung ein interessanter Ansatz:
<%
'(1)
set d=createobject("scripting.dictionary")
set f=application
y=f("input")
for j=0to ubound(y)
w=y(j)
x=1
'(2)
for i=1to len(w)
x=x+asc(mid(w,i))^4
next
'(3)
on error resume next
m=""
m=join(d(x))
' (4)
d(x)=split(trim(m&" "&w))
next
f("output")=d.items
%>
1) Auf diese Zeile bin ich stinkig. 42 Bytes, die sich nicht mehr zusammenschrumpfen lassen. Aber wie bereits gesagt, verhält sich das Dictionary später viel handlicher als ein Array...
2) Das aktuelle Wort befindet sich in "w". Ich bilde eine Summe aller Ascii-Codes, die später als gemeinsamer Nenner aller Anagramme sowie Index in meinem Dictionary dient.
3) Die Fehlerbehandlung wird abgeschaltet, damit die join()-Funktion keinen Fehler auswerfen kann. Unelegant, aber ein paar Bytes kürzer als ein "if isempty(...) else ... "
4) Das Ergebnis wird wieder zusammengefügt und in das Dictionary zurückgeschrieben. Das Dictionary-Objekt macht uns durch das Array "Items" den letzten Schritt sehr einfach.
Anmerkungen dazu: wer bremst hat Angst... Gut gegolft! Aber unser Sieger zeigt uns wie man auch ohne Fehlertricks zum Green kommt.
Roman hat das unmögliche geschafft: eine unglaublich kurze, elegante Lösung die wieder einmal neue 'Features' von VBscript aufzeigt:
<%
Set d=CreateObject("Scripting.Dictionary")
set a=Application
i=a("input")
for each e in i
s=n
for y=97to 122
s=s&ubound(split(e,chr(y)))
next
if d.exists(s)then e=join(d(s))&" "&e
d(s)=split(e)
next
a("output")=d.items
%>
Den Anfang hatten wir beim ersten Golfen schon:
2..set a=Application
3. i=a("input")
Mit [for each] spare ich mir das UBound() und die Klammern um auf das Array zuzugreifen
4. for each e in i
Mein Grundgedanke war wie man die Werte am besten vergleichen kann ohne zweimal die Arrayliste mit einem Loop durchzugehen. Die Folgerung war einen Hash zu bilden der Anagrame erkennt und mit dem man die Strings vergleichen kann.
5. for y=97to 122 6. s=s&ubound(split(e,chr(y))) 7. next
a.) Loop durch das Character Set von a chr(97) zu z chr(122)
b.) Anzahl der Zeichen in dem String
Ergebnis fuer "abbeggg"
0000000000000000000000000
1200103000000000000000000
Ok fürs golfen habe ich natürlich das ;-)
5. for y=97to 122
Die Ausgabe erfolgt mit Hilfe eines Dictionary. Ich habe mir am Anfang zwar Gedanken über den Overhead von 36 Zeichen gemacht, aber die Vorteile beim Array-Handling und Vergleich des Hashes lagen einfach auf der Hand.
1. d=CreateObject("Scripting.Dictionary")
Hier überprüfen wir: gibt es den Key schon? Wenn ja, String an das Array anhängen
8. if d.exists(s)then e=join(d(s))&" "&e
Hier den String als Array in das Dictionary schreiben
9. d(s)=split(e)
Und nun das Dictionary als Array übergeben.
12. a("output")=d.items
Anmerkungen: Gratulation! Meisterhaftes Sparen an Leerzeichen, gekoppelt mit einem eleganten Lösungsansatz und einer originellen Verwendung von 'for each' in Zeile 4... Was soll man da noch sagen? Als Schiri kann man sich da nur noch ins Klubhaus an die Bar verziehen und sich eine neue (teuflische) Aufgabe für das nächste Turnier ausdenken.
So, liebe Golffreunde, das wars für heute vom Golfplatz. Schalten sie sich wieder ein wenn sie das nächste mal 'Fore!' hören.
This printed page brought to you by AlphaSierraPapa
3. Loch - Dr. Evils Qualitätskontrolle
http:/www.aspheute.com/artikel/20021202.htm
Tee Off - Das erste ASP Golf Turnier
http:/www.aspheute.com/artikel/20020930.htm
Tee Off! Wolpertinger Genome Project
http:/www.aspheute.com/artikel/20031222.htm
Tee Off! Zahlen, Wörter, Zahlwörter
http:/www.aspheute.com/artikel/20030115.htm
Leaderboard 2. ASP Golf Turnier
http://www.aspgerman.com/golf/archiv.asp?action=leader&id=1#data
Online Golfplatz
http://www.aspgerman.com/golf/default.asp
©2000-2006 AspHeute.com
Alle Rechte vorbehalten. Der Inhalt dieser Seiten ist urheberrechtlich geschützt.
Eine Übernahme von Texten (auch nur auszugsweise) oder Graphiken bedarf unserer schriftlichen Zustimmung.