Code Optimierung

jackle32 · 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:

markieren

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:
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 · 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:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:

type TWurfData=record
points: integer; //punkte des Wurfs
strikeBonus: integer; //punkte, die ein strike davor als Bonus erhält
spareBonus: integer;  //punkte, die ein spare davor als Bonus erhält
isStrike: integer;    //0 oder 1, if-Tests nur einmal ausführen, isStrike[i]*strikeBonus[i+1] ergibt den Bonus
isSpare: integer;     //0 oder 1, if-Tests nur einmal ausführen
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 · 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 · 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.

markieren

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:
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);      // Frequenz des Zählers
    QueryPerformanceCounter (t1x);       // Zählerstand 1
    wurf(nr,10,pu,strikespare);
    for j:=0 to 300 do
      listbox1.items.add(inttostr(j)+#9+inttostr(feld[j]));
    QueryPerformanceCounter (t2x);       // Zählerstand 2
    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:

markieren

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:
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);      // Frequenz des Zählers
    QueryPerformanceCounter (t1x);       // Zählerstand 1
    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);       // Zählerstand 2
    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 · 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. :shock:

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 · 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 · Verfasst: So 30.03.14 12:56

Hallo,
so das Problem ist vom Tisch! :dance2:

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

Thorsten83 · Beiträge: 191 Erhaltene Danke: 1

Yay, dynamische Programmierung

Schöne Lösung!

Horst_H · 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 :zustimm:

Ü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 · 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 · Verfasst: So 30.03.14 17:08

Ich bin beeindruckt!! :flehan:

@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 · 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. :autsch:

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

Xion · 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 · 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:

markieren

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;
{  Sonderbehandlung aus kommentiert
    feld2:=feld;
    for j:=0 to 270 do begin
...
        if feld2[j,1]>0 then //spare im 10.
        begin
          for i:=1 to 10 do inc(feld[j+i,0]);
        end;
      end;
    end;}

Das ergibt:

markieren

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:
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:

markieren

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:
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
    //Man kann nur die uebrigen wegkegeln
    For Haus1Frame2 := 10-Haus1Frame1 downto 0 do
    begin
      iSum := Haus1Frame1+Haus1Frame2;
      write(isum:4);
      IF iSum < 10 then
        inc(AugenSumme[iSum])
      else
      begin
        //ab hier muss isum = 10 sein
        For Haus2Frame1 := 10 downto 0 do
          For Haus2Frame2 := 10-Haus2Frame1 downto 0 do
          begin
            jSum := 10+Haus2Frame1+Haus2Frame2;
            //Strike
            IF Haus1Frame1 = 10 then
            begin
              //Keine 10 folgend
              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
            //Spare
            else
              inc(AugenSumme[jsum]);
          end;
        end;
      end;
      writeln;
end;

Da kommt so ein Unsinn raus, weil ich mich in den If verstrickt habe :-(

markieren

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:
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 · 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:

markieren

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

markieren

Delphi-Quelltext

1:	for laeufe:=1 to 1 do ...

steht noch ein

markieren

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 · 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 :eyecrazy:

.

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 · 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

markieren

Quelltext

1:	Möglichkeiten = 11^96^9286 = 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 :wink:

):

markieren

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:
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);      // Frequenz des Zählers
    QueryPerformanceCounter (t1x);       // Zählerstand 1

    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 //strike im 9. und 10.
        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 //strike im 10. nicht im 9.
        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 //spare im 10.
        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);       // Zählerstand 2

    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

markieren

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:
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 · 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 :eyecrazy:

.

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 :nixweiss:

).
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.

user profile icon

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 · 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

Mathematiker hat folgendes geschrieben :

Die Komplexität des Algorithmus sinkt damit von exponentiell auf linear (denke ich :nixweiss:

).

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

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme