Autor |
Beitrag |
jackle32
Beiträge: 183
Erhaltene Danke: 7
Win7
Delphi XE5 Starter, RAD Studio XE7 Pro
|
Verfasst: Fr 28.03.14 20:39
Hallo zusammen,
ich arbeite gerade ein einem Programm, dass mir ausrechnet wie viele Möglichkeiten es gibt eine bestimmte Anzahl von Punkten beim Bowling zu erreichen.
Ich habe meine Code schon so weit mir möglich optimiert. Was jetzt noch die längste Zeit dauert ist folgende Funktion:
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54:
| function TMyThreadA.Auswertung(Feld: array of integer): integer; var i: integer; begin
for i := 0 to 8 do begin if Feld[i*2] = 10 then begin if Feld[(i+1)*2] =10 then begin self.ergebnis[i] := Feld[i*2]+Feld[(i+1)*2]+Feld[(i+2)*2]; end else if Feld[(i+1)*2+1]=10 then begin self.ergebnis[i] := Feld[i*2]+Feld[(i+1)*2+1]; end else begin self.ergebnis[i] := Feld[i*2]+Feld[(i+1)*2]+Feld[(i+1)*2+1] end; end else if Feld[i*2+1] =10 then begin self.ergebnis[i] := Feld[i*2+1]+Feld[(i+1)*2]; end else begin self.ergebnis[i] := Feld[i*2]+Feld[i*2+1]; end; end;
if Feld[18] = 10 then begin if ((Feld[20] = 10)and(Feld[19] <> 10)) then begin self.ergebnis[9] := Feld[18]+Feld[20]; end else begin self.ergebnis[9] := Feld[18]+Feld[19]+Feld[20]; end end else if Feld[19] = 10 then begin self.ergebnis[9] := Feld[19]+Feld[20]; end else begin self.ergebnis[9] := Feld[18]+Feld[19]; end;
result := SumInt(self.ergebnis); end; |
Dabei wird ein Feldarray übergeben. Jedes Feld stellt eine Wurf/Kugel im Bowlingspiel dar. Auf Grund der Regeln dabei kann man die Punktzahl nicht so leicht mit einer Formel ausrechnen. (Ich habe zumindest keine gefunden.)
Die Frage wäre jetzt wie könnte ich diesen Code optimieren, damit dieser schneller laufen kann?
Der Punkt ist eben, dass diese Funktion einmal für jede Konstellation an Punkten in den Würfen aufgerufen wird. Das sind theoretisch 11 hoch 21 mal. (Praktisch sind es weniger aber immer noch sehr viele)
Bin für jeden Hinweis dankbar!
Gruß,
Jack
_________________ Es gibt keine dummen Fragen, nur dumme Antworten.
|
|
Xion
Beiträge: 1952
Erhaltene Danke: 128
Windows XP
Delphi (2005, SmartInspect), SQL, Lua, Java (Eclipse), C++ (Visual Studio 2010, Qt Creator), Python (Blender), Prolog (SWIProlog), Haskell (ghci)
|
Verfasst: Sa 29.03.14 11:51
jackle32 hat folgendes geschrieben : | Das sind theoretisch 11 hoch 21 mal. (Praktisch sind es weniger aber immer noch sehr viele) |
Ich denke dein Ansatz kann so nicht klappen. Selbst wenn man mal 11^10 Möglichkeiten ansetzt, sind es schon...öh...ziemlich viele. Selbst wenn du 1.000.000 Möglichkeiten testen kannst pro Sekunde, dauert es dann immernoch 7 Stunden.
Es stellt sich auch die Frage, wie deine Ausgabe aussehen wird...weil wenn du dann 1Mio Möglichkeiten bekommst, wie du die vorgegebene Punktezahl erreichen kannst, dann hilft dir das doch auch nicht weiter, oder?
Wenn du für jede Punktezahl die Anzahl der Möglichkeiten bestimmen willst, dann musst du dir doch einen mathematischen Ansatz überlegen. Denn selbst die noch so tolle Funktion kann dir keine 11^21 Möglichkeiten in einer vernünftigen (oder auch unvernünftigen ) Zeit testen.
Grundsätzliche Komplexitätsreduktion:
Es ist doch egal, in welcher Runde i welche Punktezahl angenommen wird. Die Reihenfolge spielt dabei keine Rolle. Beim Generieren deiner Möglichkeiten kannst du also so vorgehen, dass die Würfe zunehmend besser werden (da man jede Wurffolge so umsortieren kann, dass die beste zuletzt und die schlechteste zuerst kommt). An der unglaublichen Größenordnung des Suchraums ändert das aber nicht viel.
Ok, so ganz klappt das auch nicht wegen den Regeln für Strike und Spare. Da müsste man sich noch was einfallen lassen.
Performantere Tests:
Die einzelnen Würfe sind weitestgehend unabhängig voneinander.
Berechne erstmal die Punktezahl für alle Einzelwürfe und bestimme, wie hoch der Bonus bei einem Strike oder Spare davor aussähe. In etwa so:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7:
| type TWurfData=record points: integer; strikeBonus: integer; spareBonus: integer; isStrike: integer; isSpare: integer; end; |
Von diesen Records gibts nur vergleichsweise wenige, sagen wir mal 11^2.
Das selbe kannst du für den letzten Wurf machen, bei dem es offenbar eine Sonderregeln gibt. Nehmen wir mal an, das sind auch 11^2 viele.
Wenn man nun alle Reihenfolgen dieser Records bestimmt, kommt man wieder auf die 11^20 Möglichkeiten, es ist aber deutlich performanter, weil man nur ein paar Zahlen des Records addieren muss und die ganzen Sprünge (if-Zweige) wegfallen. Das ganze könnte man dann noch als Assembler reinhacken.
Bei der monströsen Anzahl an Möglichkeiten ist das aber auch keine große Hilfe (selbst wenn die Funktion Fakor 1Mio schneller laufen sollte hilft das nicht wirklich).
Branch & Bound:
Einfacher Ansatz: Wenn bereits die ersten x Array-Elemente mehr Punkte verursachen als du vorgegeben hast, dann brauchst du die letzten (n-x) Array-Elemente nicht mehr alle durchprobieren, das wird dann nichts mehr.
_________________ a broken heart is like a broken window - it'll never heal
In einem gut regierten Land ist Armut eine Schande, in einem schlecht regierten Reichtum. (Konfuzius)
|
|
jackle32
Beiträge: 183
Erhaltene Danke: 7
Win7
Delphi XE5 Starter, RAD Studio XE7 Pro
|
Verfasst: Sa 29.03.14 17:26
@Xion: Danke schon mal für die Antwort.
Hier noch ein paar Hintergrundinfos:
Es sind genau 5726805883325784576 Möglichkeiten (ca. Faktor 1300 kleiner als 11^21) (Ergibt sich aus den Bowlingregeln).
Hintergrund ist, das ich die Verteilung der möglichen Punktzahlen sehen möchte (die absolute Zahl ist nicht so wichtig). Und klar wirklich sinnvoll ist die Aufgabe nicht, aber eine schöne Aufgabe, wenn man wirklich mal versuchen will wie performant ein Sourcecode gestaltet werden kann.
Durch Rekursion und Multithreading habe ich die Performance schon von 4500 gültige Berechnungen auf ca. 9,5 Mio. pro Sekunde gesteigert. Leider würde die ganze Berechnung immer noch ca. 19800 Jahre dauern . Bis 14 Kugeln lässt es sich auch schon ganz gut rechnen (Dauert nur ca. 7 Tage ).
Den Ansatz mit den Records hab ich nicht wirklich verstanden. Kannst du dafür eine kurze Beispielrechnung machen, bitte?
Gruß,
Jack
_________________ Es gibt keine dummen Fragen, nur dumme Antworten.
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: Sa 29.03.14 20:02
Hallo,
ich habe mir auch einmal ein paar Gedanken gemacht. Meine rekursive Lösung ist nicht elegant, aber funktioniert zumindest für eine kleine Anzahl von Würfen.
Allerdings fehlt noch die Spezialbehandlung eines evtl. Strikes im 10.Frame.
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66:
| procedure TForm1.Berechnung(Sender: TObject); var feld:array[0..300] of integer; pu,nr,strikespare:integer; abbruch:integer; j:integer; t1x,t2x,frequenz : TLargeInteger;
procedure wurf(nr:integer;moeglich:integer;pu:integer;strikespare:integer); var i,zusatz,doppelt:integer; begin if nr>abbruch then begin inc(feld[pu]); exit end;
for i:=0 to moeglich do begin if strikespare>0 then begin zusatz:=i; doppelt:=0; if strikespare>2 then begin zusatz:=2*i; doppelt:=1 end; if odd(nr) then begin if i=moeglich then wurf(nr+2,10,pu+i+zusatz,strikespare+1-doppelt) else wurf(nr+1,10-i,pu+i+zusatz,strikespare-1-doppelt) end else begin if i=moeglich then wurf(nr+1,10,pu+i+zusatz,strikespare-doppelt) else wurf(nr+1,10,pu+i+zusatz,strikespare-1-doppelt) end; end else begin if odd(nr) then begin if i=moeglich then wurf(nr+2,10,pu+i,strikespare+2) else wurf(nr+1,10-i,pu+i,strikespare) end else begin if i=moeglich then wurf(nr+1,10,pu+i,strikespare+1) else wurf(nr+1,10,pu+i,strikespare) end; end; end end;
begin nr:=1; pu:=0; strikespare:=0; listbox1.clear; fillchar(feld,sizeof(feld),0); abbruch:=10; QueryPerformanceFrequency (frequenz); QueryPerformanceCounter (t1x); wurf(nr,10,pu,strikespare); for j:=0 to 300 do listbox1.items.add(inttostr(j)+#9+inttostr(feld[j])); QueryPerformanceCounter (t2x); listbox1.items.insert(0,'Zeit '+FormatFloat('0.0 s',(t2x-t1x)/frequenz)); end; |
Für 10 Würfe (5 Frames) braucht mein Rechner 9 s, 11 Würfe (96 s), d.h. für 14 Würfe etwa 60 Stunden. Das ist also auch noch viel zu langsam.
Übrigens werden die Datentypen integer/int64 wohl nicht reichen, um bei 10 Frames alle Möglichkeiten zu zählen.
Mal sehen, ob ich noch etwas beschleunigen kann.
Beste Grüße
Mathematiker
Nachtrag: Ich habe es noch einmal nicht rekursiv versucht, d.h. alle möglichen Spiele werden erzeugt und ausgewertet:
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73:
| procedure TForm1.Berechnung2(Sender: TObject); var anzahl : integer; moeglichkeiten : array[1..66] of record a,b:integer end; i,j,nr:integer; zaehler : array[1..11] of integer; feld:array[0..300] of integer; t1x,t2x,frequenz : TLargeInteger; procedure auswertung; var summe,i,w1,w2:integer; strike:integer; begin summe:=0; strike:=0; i:=1; repeat w1:=moeglichkeiten[zaehler[i]].a; w2:=moeglichkeiten[zaehler[i]].b; case strike of 1,2 : begin summe:=summe+w1; dec(strike); end; 3 : begin summe:=summe+2*w1; dec(strike,2); end; end; if w1<>10 then if strike>0 then begin summe:=summe+w2; dec(strike); end;
if w1=10 then begin summe:=summe+10; inc(strike,2) end else summe:=summe+w1; if w2>0 then if w2+w1=10 then begin summe:=summe+w2; inc(strike) end else summe:=summe+w2; end; end; inc(i); until i>anzahl; inc(feld[summe]); end; begin QueryPerformanceFrequency (frequenz); QueryPerformanceCounter (t1x); listbox1.clear; fillchar(feld,sizeof(feld),0); nr:=1; for i:=0 to 10 do for j:=0 to 10-i do begin moeglichkeiten[nr].a:=i; moeglichkeiten[nr].b:=j; inc(nr); end; for i:=1 to 11 do zaehler[i]:=1; anzahl:=4;
repeat auswertung; inc(zaehler[1]); if zaehler[1]>66 then begin i:=1; while zaehler[i]>66 do begin zaehler[i]:=1; inc(zaehler[i+1]); inc(i); end; end; until zaehler[anzahl+1]>1;
for j:=0 to 300 do listbox1.items.add(inttostr(j)+#9+inttostr(feld[j])); QueryPerformanceCounter (t2x); listbox1.items.insert(0,'Zeit '+FormatFloat('0.0 s',(t2x-t1x)/frequenz));
end; |
Und das ist viel langsamer. Für 5 Frames braucht diese Lösung 36 s. Also viel schlechter.
Irgendwie komisch.
|
|
jackle32
Beiträge: 183
Erhaltene Danke: 7
Win7
Delphi XE5 Starter, RAD Studio XE7 Pro
|
Verfasst: So 30.03.14 02:14
Hallo Mathematiker,
okay die Zahlen sind echt beeindruckend. Werde mir diesen Code später mal genauer anschauen. Damit wäre mein Algorithmus ja nochmal um den Faktor 14 schneller.
Was mich jetzt natürlich brennend interessieren würde wie deine Häufigkeitsverteilung aussieht (Zahlen) und wie viele Möglichkeiten du gefunden hast.
Könntest du mir bitte diese Zahle zukommen lassen, würde die dann mit meine Ergebnissen vergleichen.
Gruß,
Jack
_________________ Es gibt keine dummen Fragen, nur dumme Antworten.
|
|
Xion
Beiträge: 1952
Erhaltene Danke: 128
Windows XP
Delphi (2005, SmartInspect), SQL, Lua, Java (Eclipse), C++ (Visual Studio 2010, Qt Creator), Python (Blender), Prolog (SWIProlog), Haskell (ghci)
|
Verfasst: So 30.03.14 02:18
jackle32 hat folgendes geschrieben : | Durch Rekursion und Multithreading habe ich die Performance schon von 4500 gültige Berechnungen auf ca. 9,5 Mio. pro Sekunde gesteigert. Leider würde die ganze Berechnung immer noch ca. 19800 Jahre dauern . Bis 14 Kugeln lässt es sich auch schon ganz gut rechnen (Dauert nur ca. 7 Tage ).
Den Ansatz mit den Records hab ich nicht wirklich verstanden. Kannst du dafür eine kurze Beispielrechnung machen, bitte?
|
Ich wollte gerade mal ein Beispiel schreiben, hab aber gemerkt, dass es da noch ein paar Details zu beachten gibt (was auch daran liegt, dass ich keine Ahnung vom Bowling hab ). Allerdings lohnt es sich nicht wirklich, das nun auszuformulieren, weil es wohl kaum genug bringen wird, um die 20k Jahre auf einen vernünftigen Wert zu senken.
Die Idee ist prinzipiell, so viel wie möglich im voraus (einmal) zu berechnen und dann diese Ergebnisse wiederzuverwenden. Wenn du in deinem Fall ein Feld [4,4,4,4,4,4,4,1] hast, und als nächstes [4,4,4,4,4,4,4,2] ausrechnest, dann berechnest du alles neu, obwohl das garnicht nötig wäre.
Außerdem ist es immer gut, gleichwertige Lösungen schnell zu erkennen. z.B. gäbe [4,4,4,4,4,4,4,1] gleich viele Punkte wie [4,4,4,1,4,4,4,4]. Das sollte man beim Kandidatengenerieren schlau integrieren, damit man die Punktezahl nur einmal ausrechnen muss. Da du alle Möglichkeiten als Häufigkeiten bestimmen willst, muss man dann aber auch noch berechnen, wie viele das nun (ursprünglich) waren.
Es gibt übrigens auch noch andere Verfahren, relative Häufigkeiten zu bestimmen. Die banale Lösung wäre, man generiert sich mal 1.000.000 Möglichkeiten zufällig und wertet deren Punkte aus. Statistisch gesehen kriegt man dann schonmal eine Näherung der Verteilung. Wenn man etwas Sympathie zur Wahrscheinlichkeitsrechnung hat (was auf mich garnicht zutrifft), kann man dann sogar noch ausrechnen, wie weit man maximal daneben liegt. (z.B. nach Hoeffding)
_________________ a broken heart is like a broken window - it'll never heal
In einem gut regierten Land ist Armut eine Schande, in einem schlecht regierten Reichtum. (Konfuzius)
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: So 30.03.14 12:56
Hallo,
so das Problem ist vom Tisch!
Mit meiner neuen Lösung braucht mein Rechner weniger als 100 ms für 10(!) Frames.
Achtung! Delphi-Quelltext weiter unten, da der hier fehlerhaft war.
Folgende Grundidee habe ich genutzt:
Da wir nicht wissen wollen, welche einzelnen Möglichkeiten für die 10 Frames auftreten, sondern nur die möglichen Punktzahlen benötigen, gehe ich portionsweise vor.
Zuerst berechne ich genau 1 Frame und speichere die möglichen Endzustände, d.h. die Punkte und evtl. noch wirkende Strikes und Spares.
Anschließend starte ich mit den 270 gespeicherten Zuständen und rechne jeweils wieder 1 Frame. Da ich weiß, wie viele Punkte am Start vorhanden waren und wie oft dieser Zustand auftrat, bekomme ich am Ende das Ergebnis nach 2 Frames.
Wiederhole ich dies noch 8 mal, habe ich alle 10 Frames berechnet.
Achtung! Das Ergebnis befindet sich in einem Beitrag weiter unten.
Und alles in gut 40 Millisekunden.
Auch ein Strike bzw. Spare im 10.Frame sind berücksichtigt.
Jetzt bin aber erst einmal stolz auf mich.
Beste Grüße
Mathematiker
Nachtrag: Fehler bei Strike im 10.Frame beseitigt. siehe weiter unten
Zuletzt bearbeitet von Mathematiker am So 30.03.14 17:23, insgesamt 5-mal bearbeitet
Für diesen Beitrag haben gedankt: Xion
|
|
Thorsten83
Beiträge: 191
Erhaltene Danke: 1
|
Verfasst: So 30.03.14 13:39
Yay, dynamische Programmierung
Schöne Lösung!
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: So 30.03.14 16:13
Hallo,
Wunderbar gelöst, aber stoppst Du die Zeit für den Eintrag in die Listbox mit
Ich habe in der Konsole mit fpc 2.6.3 ( OK 2.6.4 ist aktuell) unter Linux laufen lassen und es braucht für 100 Durchläufe 1.1 Sekunden, also 11 ms
Übrigens: Summe 1.568.336.880.910.828.616
Die Idee einen Wurf mit allen Möglickeiten zu machen und eine Augensummenliste zu machen war mir auch gekommen.
Ähnlich dem Parallelverschieben des Wurfes in www.entwickler-ecke....ewtopic.php?t=112655 wäre es hier eine Addition der Augenzahlen und der dort eingetragenen absoluten Häufigkeit.Das wäre komplett ohne if.
Aber die letzten Würfe wäre etwas schwieriger.
Ich probiere das mal.
Gruß Horst
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: So 30.03.14 16:44
Hallo,
Horst_H hat folgendes geschrieben : | ... aber stoppst Du die Zeit für den Eintrag in die Listbox mit |
Oh je, genau das mache ich. Die reine Berechnung liegt bei nur 3,0-3,1 ms.
Wenn man sich überlegt, dass am Anfang 19800 Jahre Rechenzeit veranschlagt wurden, so ist dies wieder ein schönes Beispiel dafür, dass eigentlich immer der Algorithmus über die Geschwindigkeit entscheidet. Mit einem neuen Verfahren verkürzt sich die Berechnungszeit um den Faktor 200 Billionen(!). Um das mit besserer Hardware zu erreichen, müssen viele, viele Generationen von PCs vergehen.
Auch meine Lösung hat noch einen Schwachpunkt. Mit etwas mehr Aufwand könnte ich die Rekursion noch vollkommen 'rauswerfen. Das dürfte noch etwas Zeitgewinn bringen. Mal sehen, was noch möglich ist.
Beste Grüße
Mathematiker
|
|
jackle32
Beiträge: 183
Erhaltene Danke: 7
Win7
Delphi XE5 Starter, RAD Studio XE7 Pro
|
Verfasst: So 30.03.14 17:08
Ich bin beeindruckt!!
@Mathematiker:
Einen kleinen Makel hab ich aber doch noch. Bei deiner Berechnung gibt es keine Möglichkeit 299 Punkte zu erreichen, was natürlich beim Bowling möglich ist. Und zwar mit 20 Strikes und einer 9 am Schluss. Daher denke ich du beachtest den optionalen 3. Wurf im 10 Frame noch nicht.
Ansonsten bin ich aber tief beeindruckt.
Gruß,
Jack
_________________ Es gibt keine dummen Fragen, nur dumme Antworten.
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: So 30.03.14 17:21
Hallo,
jackle32 hat folgendes geschrieben : | Bei deiner Berechnung gibt es keine Möglichkeit 299 Punkte zu erreichen, was natürlich beim Bowling möglich ist. ... |
Sorry, da ich kein Bowling-Spieler bin, habe ich wohl etwas falsch verstanden.
Ich denke jetzt habe ich es aber richtig: ( Das war ein Trugschluss, weiter unten ist es richtig.)
Achtung! Delphi-Quelltext weiter unten.
Beste Grüße
Mathematiker
Zuletzt bearbeitet von Mathematiker am Mo 31.03.14 22:06, insgesamt 1-mal bearbeitet
Für diesen Beitrag haben gedankt: jackle32
|
|
Xion
Beiträge: 1952
Erhaltene Danke: 128
Windows XP
Delphi (2005, SmartInspect), SQL, Lua, Java (Eclipse), C++ (Visual Studio 2010, Qt Creator), Python (Blender), Prolog (SWIProlog), Haskell (ghci)
|
Verfasst: So 30.03.14 17:28
Mathematiker hat folgendes geschrieben : | Mit einem neuen Verfahren verkürzt sich die Berechnungszeit um den Faktor 200 Billionen(!). |
Richtig, insbesondere hast du die Komplexität des Lösungsverfahrens ganz wesentlich reduziert, wenn man mehr Würfe machen würde, käme also ein noch viel höherer Faktor raus.
Wenn ich da sehen muss, wie lange heutige Office-Pakete zum starten brauchen...das kommt halt dabei raus, wenn man ganz und gar auf die Effizienz des C++-Compilers vertraut und sich um die Algorithmen deswegen keine Gedanken mehr macht...
_________________ a broken heart is like a broken window - it'll never heal
In einem gut regierten Land ist Armut eine Schande, in einem schlecht regierten Reichtum. (Konfuzius)
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: So 30.03.14 21:40
Hallo,
ich wollte mal einen einzelnen Wurf "sehen".
Also nur bis 30 und die Sonderregel für die letzten Würfe auskommentiert:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28:
| for laeufe:=1 to 1 do begin feld2:=feld; fillchar(feld,sizeof(feld),0); for j:=0 to 30 do for m:=0 to 3 do begin if feld2[j,m]>0 then begin faktor:=feld2[j,m]; summand:=j; nr:=1; pu:=0; strikespare:=m; wurf(nr,10,pu,strikespare); end; end; end; |
Das ergibt:
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32:
| 0 1 1 4 2 10 3 20 4 35 5 56 6 84 7 120 8 165 9 220 10 286 11 328 12 370 13 384 14 398 15 380 16 362 17 308 18 254 19 160 20 66 21 50 22 57 23 40 24 48 25 30 26 39 27 20 28 30 29 10 30 21 Summe 4356 |
Wie kann 4 mal die 1 vorkommen?
de.wikipedia.org/wiki/Bowling ( Haus/Frame sind dort erklärt )
Es bei ersten Haus nur Frame1 = 0..1 und Frame2 = 1..0 sein also 2 Möglichkeiten.
Hier sieht es so aus, als würde das zweite Haus mit ein bezogen.
10 Möglichekten für 2 sehe ich auch nicht.
0/2 oder 1,1 oder 2/0 im ersten Haus.
Ich habe mal dies für die Augensumme eines Wurfes gepinselt:
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47:
| procedure AugenSummeErstellen; var Haus2Frame1,Haus2Frame2,Haus1Frame1,Haus1Frame2,i, iSum,jsum: LongWord;
begin Fillchar(AugenSumme,SizeOf(AugenSumme),#0); For Haus1Frame1 := 10 downto 0 do For Haus1Frame2 := 10-Haus1Frame1 downto 0 do begin iSum := Haus1Frame1+Haus1Frame2; write(isum:4); IF iSum < 10 then inc(AugenSumme[iSum]) else begin For Haus2Frame1 := 10 downto 0 do For Haus2Frame2 := 10-Haus2Frame1 downto 0 do begin jSum := 10+Haus2Frame1+Haus2Frame2; IF Haus1Frame1 = 10 then begin IF jSum <20 then inc(AugenSumme[jsum]) else begin IF Haus2Frame1 = 10 then Begin For i := 0 to 10 do inc(AugenSumme[jsum+i]) end else inc(AugenSumme[jsum]); end; end else inc(AugenSumme[jsum]); end; end; end; writeln; end; |
Da kommt so ein Unsinn raus, weil ich mich in den If verstrickt habe
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31:
| 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 10 10 11 // Haus1 = 10/Haus2 = 0 // 11 von 66 sind 10 11 22 // 11 x Anzahl Haus2=1 == Haus1= 1 also Faktor 2 12 33 13 44 14 55 15 66 16 77 17 88 18 99 19 110 20 121 21 1 //Haus1Frame1=Haus2Frame1= 10 22 1 23 1 24 1 25 1 26 1 27 1 28 1 29 1 30 1 |
Ganz koscher ist mir die Sache noch nicht
Gruß Horst
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: So 30.03.14 21:52
Hallo,
Horst_H hat folgendes geschrieben : | ich wollte mal einen einzelnen Wurf "sehen".
Also nur bis 30 und die Sonderregel für die letzten Würfe auskommentiert:
Delphi-Quelltext 1: 2:
| for laeufe:=1 to 1 do .... |
Hier sieht es so aus, als würde das zweite Haus mit ein bezogen. |
Richtig. Du hast übersehen, dass die Schleife die Wiederholungen der Frame-Berechnung sind.
Vor
Delphi-Quelltext 1:
| for laeufe:=1 to 1 do ... |
steht noch ein
Delphi-Quelltext 1:
| wurf(nr,10,pu,strikespare); |
für den 1.Frame. D.h., möchtest Du nur den 1.Frame sehen, muss die Schleife vollkommen raus.
Einen einzelnen Wurf, also den 1.Teil eines Frames, kannst Du nur sehen, wenn Du die abbruch-Variable auf 1 setzt und natürlich die Schleife rausnimmst. Durch die Rekursion berechne ich bei Aufruf der wurf-Routine mit nr:=1 immer zwei Würfe, also einen Frame.
Natürlich können sich noch Fehler verstecken. Aber das Genannte müsste korrekt sein.
Beste Grüße
Mathematiker
|
|
jackle32
Beiträge: 183
Erhaltene Danke: 7
Win7
Delphi XE5 Starter, RAD Studio XE7 Pro
|
Verfasst: Mo 31.03.14 20:50
Hallo zusammen,
ich sehe schon die Diskussionen gehen noch weiter .
Eine kleine Anmerkung/Frage hab ich noch. Ich finde den Code echt schnell und habe bis jetzt noch nicht wirklich verstanden wie der funktioniert .
Was ich aber noch komisch finde, ist die Gesamtzahl der Möglichkeiten. Eigentlich sollten es, wie oben schon mal beschrieben, 572680588332578457 Möglichkeiten sein. Auf die Zahl komme ich durch eine Betrachtung der ersten Anzahlen an Möglichkeiten. Dabei ergibt sich eine Regel. Für jede erste Kugel im Frame muss die Anzahl mal 11 genommen werden und für jede zweite Kugel im Frame, ergibt sich auf Grund der Bowlingregeln, ein Faktor von 6. Im letzten Frame gibt es dann nochmal 241 Möglichkeiten.
So komme ich auf:
Möglichkeiten = 11^9*6^9*241
Bei dem vorher vorgestellten Code kommen aber "nur" 1568336880910855136 Möglichkeiten raus.
Mach ich da jetzt den Fehler oder ist der Code oben doch noch nicht ganz richtig? (Vermutung meinerseits ist, dass nicht alle Möglichkeiten im 10 Frame berücksichtigt werden)
@Horst_H: Für einen Wurf gibt es ja nur die Punktezahlen 0-10 und jede genau einmal. Also gibt es genau 11 Möglichkeiten. Oder verstehe ich da schon wieder was falsch?
Gruß,
Jack
_________________ Es gibt keine dummen Fragen, nur dumme Antworten.
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: Mo 31.03.14 22:02
Hallo,
jackle32 hat folgendes geschrieben : | Eigentlich sollten es, wie oben schon mal beschrieben, 572680588332578457 Möglichkeiten sein. ...Möglichkeiten = 11^9*6^9*241 |
Sorry, das stimmt nicht.
Im 10.Frame gibt es 55 Möglichkeiten Pins stehen zu lassen, ohne einen weiteren Wurf. 10 Möglichkeiten für einen Spare mit einem weiteren Wurf mit 11 möglichen Ausgängen. Der 1 Strike hat 2 Würfe zur Folge mit je 11 Ausgängen.
Damit gibt es im 10.Frame 55 + 10*11 + 1*11*11 = 286 Möglichkeiten und insgesamt für ein Bowling-Game
Quelltext 1:
| Möglichkeiten = 11^9*6^9*286 = 6796126483946781696 |
Da ich in meinem Programm natürlich bei dieser Auswertung immer noch einen Fehler hatte, war das Ergebnis falsch.
Ich hatte vergessen, die Anzahl der möglichen Wege zu einem Spare/Strike im 10.Frame zu berücksichtigen.
Jetzt ist es aber richtig (hoffe ich ):
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124:
| procedure TForm1.Berechnung(Sender: TObject); var feld,feld2:array[0..300,0..3] of int64; pu,nr,strikespare:integer; abbruch:integer; i,j,m:integer; faktor,summand,summe:int64; t1x,t2x,frequenz : TLargeInteger; laeufe:integer; procedure wurf(nr:integer;moeglich:integer;pu:integer;strikespare:integer); var i,zusatz,doppelt:integer; begin if nr>abbruch then begin feld[pu+summand,strikespare]:=faktor+feld[pu+summand,strikespare]; exit end;
for i:=0 to moeglich do begin if strikespare>0 then begin zusatz:=i; doppelt:=0; if strikespare>2 then begin zusatz:=2*i; doppelt:=1 end; if odd(nr) then begin if i=moeglich then wurf(nr+2,10,pu+i+zusatz,strikespare+1-doppelt) else wurf(nr+1,10-i,pu+i+zusatz,strikespare-1-doppelt) end else begin if i=moeglich then wurf(nr+1,10,pu+i+zusatz,strikespare-doppelt) else wurf(nr+1,10,pu+i+zusatz,strikespare-1-doppelt) end; end else begin if odd(nr) then begin if i=moeglich then wurf(nr+2,10,pu+i,strikespare+2) else wurf(nr+1,10-i,pu+i,strikespare) end else begin if i=moeglich then wurf(nr+1,10,pu+i,strikespare+1) else wurf(nr+1,10,pu+i,strikespare) end; end; end end; begin nr:=1; pu:=0; strikespare:=0; listbox1.clear; fillchar(feld,sizeof(feld),0); fillchar(feld2,sizeof(feld2),0); abbruch:=2; QueryPerformanceFrequency (frequenz); QueryPerformanceCounter (t1x); faktor:=1; summand:=0; wurf(nr,10,pu,strikespare);
for laeufe:=1 to 9 do begin feld2:=feld; fillchar(feld,sizeof(feld),0); for j:=0 to 270 do for m:=0 to 3 do begin if feld2[j,m]>0 then begin faktor:=feld2[j,m]; summand:=j; nr:=1; pu:=0; strikespare:=m; wurf(nr,10,pu,strikespare); end; end; end;
feld2:=feld; for j:=0 to 270 do begin begin if (feld2[j,3]>0) then begin dec(feld[j,0],feld2[j,3]); for i:=0 to 10 do for m:=0 to 10 do begin inc(feld[j+m+2*i,0],feld2[j,3]) end; end; if (feld2[j,2]>0) then begin dec(feld[j,0],feld2[j,2]); for i:=0 to 10 do for m:=0 to 10 do begin inc(feld[j+m+i,0],feld2[j,2]) end; end; if feld2[j,1]>0 then begin dec(feld[j,0],feld2[j,1]); for i:=0 to 10 do inc(feld[j+i,0],feld2[j,1]); end; end; end; QueryPerformanceCounter (t2x); summe:=0; for j:=0 to 300 do begin listbox1.items.add(inttostr(j)+#9+inttostr(feld[j,0]+feld[j,1]+feld[j,2]+feld[j,3])); summe:=summe+feld[j,0]+feld[j,1]+feld[j,2]+feld[j,3]; end; listbox1.items.insert(0,'Summe '+inttostr(summe)); listbox1.items.insert(0,'Zeit '+FormatFloat('0.0 ms',1000*(t2x-t1x)/frequenz)); listbox1.items.insert(0,'10 Frames'); listbox1.items.savetofile('Lrekursiv.txt'); end; |
mit dem Endergebnis
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209: 210: 211: 212: 213: 214: 215: 216: 217: 218: 219: 220: 221: 222: 223: 224: 225: 226: 227: 228: 229: 230: 231: 232: 233: 234: 235: 236: 237: 238: 239: 240: 241: 242: 243: 244: 245: 246: 247: 248: 249: 250: 251: 252: 253: 254: 255: 256: 257: 258: 259: 260: 261: 262: 263: 264: 265: 266: 267: 268: 269: 270: 271: 272: 273: 274: 275: 276: 277: 278: 279: 280: 281: 282: 283: 284: 285: 286: 287: 288: 289: 290: 291: 292: 293: 294: 295: 296: 297: 298: 299: 300: 301: 302: 303: 304:
| 10 Frames Zeit 3,1 ms Summe 6796126483946781696 0 1 1 20 2 210 3 1540 4 8855 5 42504 6 177100 7 657800 8 2220075 9 6906900 10 20030010 11 54627084 12 141116637 13 347336412 14 818558424 15 1854631380 16 4053948342 17 8574134256 18 17590903116 19 35084425512 20 68153183370 21 129156542048 22 239128282298 23 433093981988 24 768175041710 25 1335679120556 26 2278764602850 27 3817722438568 28 6285429080478 29 10176062216148 30 16210692174654 31 25423801988711 32 39275063100176 33 59790697496322 34 89738372684186 35 132838680323437 36 194014728204860 37 279679139693760 38 398054762537508 39 559521664930589 40 776978653753348 41 1066202799665260 42 1446185611494100 43 1939419976193134 44 2572108249645769 45 3374259457662750 46 4379642940349963 47 5625567357096640 48 7152458043083713 49 9003212336203823 50 11222321532368224 51 13854759161115192 52 16944647743901701 53 20533729301988559 54 24659677860186344 55 29354304148304945 56 34641713010992584 57 40536482068392501 58 47041935721268511 59 54148591515303027 60 61832856328337207 61 70056047874106382 62 78763812552417848 63 87886003727141549 64 97337074436149062 65 107017025187655349 66 116812929896943652 67 126601040952965360 68 136249447673994686 69 145621230941047405 70 154578023388704719 71 162983849241515226 72 170709088648566810 73 177634384171611642 74 183654297882070924 75 188680521351588656 76 192644465812746882 77 195499080514586477 78 197219810486845292 79 197804643162782380 80 197273281919910624 81 195665512419350681 82 193038919748521443 83 189466103203616503 84 185031613877402891 85 179828771486938774 86 173956578610064346 87 167516824806621490 88 160611535360618762 89 153340758003385986 90 145800774190430760 91 138082647938002508 92 130271158391553242 93 122443988821502259 94 114671214858346804 95 107014965207142134 96 99529316953401488 97 92260318022597233 98 85246208282329046 99 78517740682068333 100 72098652514008614 101 66006199334529111 102 60251775159824131 103 54841552248003292 104 49777135329252582 105 45056197268658240 106 40673066658891714 107 36619283524849712 108 32884076638726293 109 29454833177593810 110 26317485122896863 111 23456908635875939 112 20857234388365595 113 18502182572119847 114 16375303784595863 115 14460246361373049 116 12740927756506924 117 11201725269315914 118 9827577691852470 119 8604097298922082 120 7517623435041577 121 6555279475092260 122 5704999087362183 123 4955540166398617 124 4296494273383449 125 3718264495134961 126 3212064544051489 127 2769868097847448 128 2384402878185286 129 2049078806304698 130 1757974114299839 131 1505754391758305 132 1287659451250235 133 1099424037886546 134 937267436029853 135 797821186857866 136 678119270755147 137 575535421023447 138 487770924922894 139 412804404510562 140 348876645295098 141 294448665636652 142 248185443705358 143 208923745048864 144 175656730614255 145 147510746486271 146 123731973429538 147 103669456538203 148 86764842662111 149 72537378537783 150 60578177501888 151 50536214890777 152 42115446975801 153 35061321365011 154 29160887511157 155 24229958141802 156 20115834808496 157 16685484152606 158 13829697883806 159 11453236393604 160 9478404992247 161 7837593101077 162 6476213784270 163 5346802795303 164 4411310509036 165 3636591415967 166 2996161862009 167 2466840298337 168 2030202536115 169 1669880317268 170 1373147467849 171 1128523301863 172 927259997087 173 761413559223 174 625048494164 175 512734560849 176 420467914638 177 344556136065 178 282280015222 179 231136351367 180 189242273117 181 154873544243 182 126752021339 183 103683420604 184 84815203997 185 69330282593 186 56671988874 187 46281850393 188 37801598801 189 30845298453 190 25179932440 191 20541744061 192 16769933064 193 13682171259 194 11172093269 195 9114126181 196 7440097275 197 6065370784 198 4947123565 199 4028486998 200 3282838119 201 2670711130 202 2175609709 203 1769453489 204 1441628168 205 1172344299 206 954967135 207 776026493 208 631459648 209 512373550 210 416233569 211 337247139 212 273851883 213 221927233 214 180418481 215 146428507 216 119237728 217 96891799 218 78921329 219 64067771 220 52068026 221 42138314 222 34152371 223 27577320 224 22336328 225 18033977 226 14624710 227 11818153 228 9592127 229 7747533 230 6276629 231 5048967 232 4071153 233 3262152 234 2626975 235 2105501 236 1704582 237 1374301 238 1122858 239 911228 240 748223 241 605405 242 493552 243 394883 244 319773 245 253232 246 204620 247 161517 248 130825 249 103624 250 84595 251 67510 252 54946 253 43403 254 34836 255 26996 256 21567 257 16728 258 13534 259 10811 260 9074 261 7536 262 6342 263 5206 264 4290 265 3422 266 2750 267 2126 268 1663 269 1250 270 971 271 735 272 626 273 509 274 420 275 324 276 257 277 184 278 141 279 93 280 76 281 55 282 56 283 45 284 46 285 35 286 36 287 25 288 26 289 15 290 16 291 5 292 5 293 4 294 4 295 3 296 3 297 2 298 2 299 1 300 1 |
Ich muss schon sagen: Das war ein hartes Problem.
Beste Grüße
Mathematiker
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: Mo 31.03.14 22:53
Hallo,
jackle32 hat folgendes geschrieben : | Ich finde den Code echt schnell und habe bis jetzt noch nicht wirklich verstanden wie der funktioniert . |
Tut mir leid, ich hatte vergessen den Algorithmus noch zu erklären.
Allerdings werde ich Spares und Strikes und die Zusatzwürfe im 10.Frame mal nicht berücksichtigen, da diese für den Algorithmus unwichtig sind.
Ursprünglich rechnest Du je Frame 66 Möglichkeiten und damit 66^10 = 1,5 Trillionen Schritte. Und das dauert.
Mit den Frames 1,2,3,... werden es 66, 4356, 287496, ... Berechnungen.
Ich rechne am Anfang einen Frame (66 Berechnungen). Das Ergebnis speichere ich einer Tabelle. Diese enthält für die (normalen) Punktzahlen von 0 bis 270 jeweils, auf wie viele Möglichkeiten ich zu den jeweiligen Punkten gelangt bin und natürlich ob ein Spare oder Strike geworfen wurde.
Für diese 270 Punktmöglichkeiten rechne ich einen weiteren Frame, berücksichtige aber, dass ich jede nun erreichbare Punktmöglichkeit mit den im vorhergehenden Frame ermittelten Häufigkeiten multiplizieren muss.
Damit brauche ich für den 2.Frame insgesamt 66 + 270*66 = 17886 Rechnungen.
Dieses Verfahren wiederhole ich nun noch 8 mal. Im Ergebnis brauche ich also nur
66 + 9 * (270*66) = 160446 Berechnungen.
Das ist weniger als bei 3 Frames nach der ursprünglichen Methode. Und deshalb ist es so schnell.
Die Komplexität des Algorithmus sinkt damit von exponentiell auf linear (denke ich ).
In 1 Sekunde Rechenzeit könnte ich wahrscheinlich so mehr als 1000 aufeinanderfolgende Frames durchrechnen. Natürlich geht das nicht, da ich dann die int64-Grenze überschreiten würde. Außerdem müsste die Tabelle größer werden, was wiederum Rechenzeit kostet.
Thorsten83 hatte ja schon auf den Begriff "dynamische Programmierung" hingewiesen.
Wenn meine Erklärung zu verwirrend ist, kannst Du ja unter de.wikipedia.org/wik...ische_Programmierung nachlesen. Dort ist es sicher besser erklärt.
Beste Grüße
Mathematiker
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Di 01.04.14 07:35
Hallo,
Das ist das gleiche Prinzip wie bei der Bestimmung der Häufigkeit einer gewissen Augenzahl bei n -Würfen mit x - Würfeln mit z Seiten.( dort habe ich z = 6 vorgegeben, hier wäre es 0..30 ). Weshalb mein Codeschnipsel Augensumme hieß.
Alle Kombinationsmöglichkeiten der Würfel ermitteln
Ein schlechter Titel.
Gruß Horst
|
|
Thorsten83
Beiträge: 191
Erhaltene Danke: 1
|
Verfasst: Di 01.04.14 10:56
Mathematiker hat folgendes geschrieben : | Die Komplexität des Algorithmus sinkt damit von exponentiell auf linear (denke ich ).
|
Genau genommen stimmt das nicht
Da die Anzahl der Würfe sowie die erzielbaren Punkte durch einen konstanten Wert beschränkt sind, hat man in beiden Fällen eine konstante Laufzeit.
Das ist ein schönes Beispiel dafür, dass die asymptotische Komplexität von Algorithmen zwar ein vielen Fällen hilfreich ist, aber nicht immer.
Grüße,
Thorsten
|
|
|