Entwickler-Ecke

Grafische Benutzeroberflächen (VCL & FireMonkey) - Alle Kombinationsmöglichkeiten der Würfel ermitteln


florida - So 09.02.14 18:43
Titel: Alle Kombinationsmöglichkeiten der Würfel ermitteln
Ich bin hier fast am Verzweifeln...

Ich kann mich in einem Programm entscheiden, wieviele Würfel ich nehme (1-5).
Und nun brauche ich alle Kombinationsmöglichkeiten für eine bestimmte Augensumme (sagen wir 10 bei 4 Würfeln).

Ich habe mir gedacht, dass alle Möglichkeiten durchgezählt werden sollen und dann die Anzahl der Augensummen berechnen werden soll (muss ich noch machen).
Die Messageboxen habe ich nur reingemacht, damit ich sehe, ob es richtig abläuft. Und bisher geht es auch, wenn ich 2 Würfel habe, ansonssten funktioniert es nicht.

Memo1


Delphi-Quelltext 
1:
2:
3:
 
1
1
1


Im Memo sind 3 Zeilen für 3 Würfel, deren Möglichkeiten durchgezählt werden sollen und jedes Mal davon die Augensumme gebildet werden soll (noch nicht fertig).


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:
 
var
  i, ii, iii, iiii, zeile_zahl, augensumme, anzahl: integer;
  fertig: boolean;
begin
  zeile_zahl := 0;
  augensumme := 0;
  anzahl := 0;

  fertig := false;

  for i := Memo1.Lines.Count - 1 downto 0 do
  begin
    if i < Memo1.Lines.Count - 1 then
    begin
      for ii := i to Memo1.Lines.Count - 1 do
      begin
        Memo1.Lines[i + ii - 1] := '1';
      end;
    end;

    for ii := 1 to 5 do
    begin
      Memo1.Lines[i] := inttostr(strtoint(Memo1.Lines[i]) + 1);

      if (i < Memo1.Lines.Count - 1) then
      begin
        Memo1.Lines[i + 1] := '1';
      end;

      showmessage('');

      for iii := 1 to 5 do
      begin
        if (i < Memo1.Lines.Count - 1) then
        begin
          Memo1.Lines[i + 1] := inttostr(strtoint(Memo1.Lines[i + 1]) + 1);
        end;

        showmessage('');
      end;

      zeile_zahl := strtoint(Memo1.Lines[i]);

      showmessage('');
    end;

    fertig := true;
  end;


Hat jemand einen Tipp?


mandras - So 09.02.14 21:22
Das schreit nach einer rekursiven Lösung...

Idee:
Ich will das Problem für N Würfel, gewünschte Augenzahl A lösen.
Weiß aber nicht wie.
Ich weiß aber bei mindestens 2 Würfeln:
Der erste kann die Augenzahlen a=1 bis 6 erreichen, also müssen die restlichen eine Augenzahl von A-a ergeben.
Mit dieser Info ruft sich eine Prozedur selbst für immer weniger verbleibende Würfel auf und merkt sich, was die bisherigen Würfel ergaben.
Wenn ich zum Schluß nur noch 1 Würfel übrig habe, weiß ich, welche Augenzahl dieser aufweisen muß, diese darf nur im Bereich 1..6 liegen.

Hier als Code:

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:
 
var AnzW, gewAugen:integer;

procedure TForm1.Button1Click(Sender: TObject);
begin
 AnzW:=StrToInt(Edit1.Text);
 gewAugen:=StrToInt(Edit2.Text);
 Memo1.Lines.Clear;
 // erst prüfen, ob diese Aufgabe überhaupt lösbar ist
 if gewAugen < AnzW then begin
  memo1.lines.add (format ('mit %d Würfeln lassen sich nur mehr als %d Augen erreichen',[AnzW,gewAugen] ));
  exit;
 end;
 if gewAugen > AnzW*6 then begin
  memo1.lines.add (format ('mit %d Würfeln lassen sich nicht %d Augen erreichen',[AnzW,gewAugen] ));
  exit;
 end;
 // Aufgabe ist lösbar, also alle Lösungen angeben.
 Berechne (AnzW, gewAugen,'');
end;

procedure TForm1.Berechne (AnzW, gewAugen:integer; bisher:string);
var k:integer;
begin
 // Wenn nur noch 1 Würfel bleibt und gewAugen im Bereich 1..6,
 // dann besteht die Lösung aus der bisherigen plus <gewAugen>,
 // also dieses ausgeben und schluß.
 // falls gewAugen nicht in 1..6, dann gibt es keine Lösung.
 if (AnzW = 1) then begin
  if (gewAugen in [1..6]) then Memo1.Lines.Add (bisher+inttostr(gewAugen));
  exit;
 end;
 // es sind noch mindestens 2Würfel übrig, also für den ersten die
 // Augenzahl 1..6 durchlaufen und die restl. Würfel mit der
 // um diese reduzierte prüfen
 for k:=1 to 6 do Berechne (AnzW-1, gewAugen-k, bisher+inttostr(k));
end;


Blup - Mo 10.02.14 16:29
Die durchschnittlich bei einem Würfel mit einem Wurf erreichte Punktzahl:

(1 + 6 + 2 + 5 + 3 + 4) / 6 = 3,5

Die bei N Würfen erreichte durchschnittliche Punktezahl X:

3,5 * n = x

Um also eine vorher bestimmte Punktezahl zu erreichen, dividiert man diese Zahl durch 3,5 und wählt die dem Ergebnis nächste ganze Zahl.


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:
 
type
  TWuerfeResult = record
    Gesamt: Integer;
    Anzahl: array of Integer;
  end;

function BerechneWuerfe(AWuerfeAnzahl: Integer): TWuerfeResult;
var
  i1, i2, m, n: Integer;
begin
  Result.Gesamt := Trunc(IntPower(6, AWuerfeAnzahl));
  SetLength(Result.Anzahl, 6 * AWuerfeAnzahl + 1);
  for i1 := 0 to High(Result.Anzahl) do
    Result.Anzahl[i1] := 0;

  n := 6 * AWuerfelAnzahl;
  for i1 := 0 to Result.Gesamt - 1 do
  begin
    m := i1;
    for i2 := 1 to AWuerfeAnzahl do
    begin
      n := n + 1;
      if (m mod 6) <> 0 then
        Break;
      n := n - 6;
      m := m div 6;
    end;
    Inc(Result.Anzahl[n]);
  end;
end;


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:
 
Würfe: 2
Gesamtmöglichkeiten: 36
 0: 0
 1: 0
 2: 1
 3: 2
 4: 3
 5: 4
 6: 5
 7: 6
 8: 5
 9: 4
10: 3
11: 2
12: 1

Würfe: 5
Gesamtmöglichkeiten: 7776
 0: 0
 1: 0
 2: 0
 3: 0
 4: 0
 5: 1
 6: 5
 7: 15
 8: 35
 9: 70
10: 126
11: 205
12: 305
13: 420
14: 540
15: 651
16: 735
17: 780
18: 780
19: 735
20: 651
21: 540
22: 420
23: 305
24: 205
25: 126
26: 70
27: 35
28: 15
29: 5
30: 1

Die Wahrscheinlichkeit mit 5 Würfen genau die 18 zu erreichen liegt bei 780/7776 etwa 10%.


mandras - Mo 10.02.14 20:26
Wenn ich florida richtig verstanden habe ging um N Würfel und nicht um N Würfe


Horst_H - Mo 10.02.14 21:52
Hallo,

es ist die Frage, ob er wirklich als Ausgabe für die Augenzahl 6 mit 5 Würfeln so etwas haben möchte:
1,1,1,1,2/1,1,1,2,1/1,1,2,1,1/1,2,1,1,1/2,1,1,1,1
oder nur die Anzahl der Möglichkeiten, die dann 5 wäre.

Gruß Horst
Eine andere Variante für die Anzahl:
Sie entsteht durch die Addition der 6 Verschiebungen der Vorgängers.

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:
 
program AugenWuerfel;
{$IFdef fpc}
  {$MOde Delphi}
{$Else}
   {$Apptype Console}
{$ENDIF}
uses
  sysutils;
const
  AnzAugenzahl: array[1..6] of integer =(1,1,1,1,1,1);
  MaxAnzWuerfel = 5;
var
  i,j,l,k: integer;
  AnzAugen,AnzAugenZuvor : array of integer;
begin
  //ausreichendes Feld mit 0 initialisiert
  setlength(AnzAugenZuvor,(MaxAnzWuerfel-1)*6+1);
  setlength(AnzAugen,MaxAnzWuerfel*6+1);
  For i := 1 to 6 do
    AnzAugenZuvor[i]:= AnzAugenzahl[i];

  l := 6;
  For k := 1 to MaxAnzWuerfel-1 do
  begin
    AnzAugen[k] := 0;
    For i := 1 to l do
      For j := 1 to 6 do
        AnzAugen[i+j] := AnzAugen[i+j]+AnzAugenZuvor[i];
    inc(l,6);
    For i :=1 to l do
    begin
      write(AnzAugen[i]:5);
      AnzAugenZuvor[i]:= AnzAugen[i];
      AnzAugen[i] := 0;
      end;
   writeln;
   end;
readln
end.


Quelltext 
1:
2:
3:
4:
5:
6:
7:
 
    0    1    2    3    4    5    6    5    4    3    2    1
    0    0    1    3    6   10   15   21   25   27   27   25   21   15   10    6
    3    1
    0    0    0    1    4   10   20   35   56   80  104  125  140  146  140  125
  104   80   56   35   20   10    4    1
    0    0    0    0    1    5   15   35   70  126  205  305  420  540  651  735
  780  780  735  651  540  420  305  205  126   70   35   15    5    1


Horst_H - Di 11.02.14 10:20
Hallo,

der Code-Schnipsel von user profile iconBlup scheint mir etwas merkwürdig.
Im Prinzip zerlegt er die Kombinationsnummer in eine Wurf aus AWuerfeAnzahl Wuerfen eines Wuerfels.
Das wäre aber so:

Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
 
function BerechneWuerfe(AWuerfeAnzahl: Integer): TWuerfeResult;
const
  Seitenzahl = 6;
..
  for i1 := 0 to Result.Gesamt - 1 do
  begin
    m := i1;// Nummer des Wurfes
    n := 0;// Würfelsumme
    for i2 := 1 to AWuerfeAnzahl do
    begin
      //m mod SeitenZahl +1 -> Augenzahl eines Wurfes
      n := n + m mod SeitenZahl +1; // +1 Wegen 0..5-> 1..6
      m := m div SeitenZahl;// Den letzten Wurf entfernen
    end;
    Inc(Result.Anzahl[n]);
  end;


Gruß Horst


Blup - Di 11.02.14 15:35
@Horst_H
Der von dir veränderte Code liefert das richtige Ergebnis.
Für 5 Würfe durchläuft dieser Code die innere Schleife 38880 mal.
38880 mod-Operationen
38880 div-Operationen

Der von mir ursprünglich gepostete Code liefert das selbe Ergebnis.
Für 5 Würfe durchläuft dieser Code die innere Schleife 9330 mal.
9330 mod-Operationen
1555 div-Operationen

Im Prinzip gehe ich alle Würfelkombinationen der Reihenfolge durch.
Jede folgende Kombination hat einen um 1 höhere Summe.

Quelltext 
1:
2:
3:
4:
5:
6:
7:
 
1 1 1 1 1    = 5
1 1 1 1 2    = 6 (+1)
1 1 1 1 3    = 7 (+1)
1 1 1 1 4    = 8 (+1)
1 1 1 1 5    = 9 (+1)
1 1 1 1 6    = 10 (+1)
1 1 1 2 1    = 6 (+1-6+1)

Bei einem Übertrag verringert sich die Summe um 6.
In der Übertragsspalte erhöht sich die Summe zusätzlich um 1.
Dafür ist die innere Schleife zuständig.


Horst_H - Di 11.02.14 19:09
Hallo,

da bin ich ja froh, das mein Vorschlag nur Additionen braucht.
Es ist ähnlich wie ein Pascalsches Dreieck ( Zweiseitiger Würfel = Münze ), dort wird immer nur um eine Stelle verschoben und addiert:
1
11
121
1331
Da kann man aber die einzelnen Werte leicht mit n über k berechnen.
Wie hier die Formel aussehen würde, sehe ich jetzt nicht, das ist was für Mathematiker

Gruß Horst


Blup - Mi 12.02.14 12:54
Das Additionsverfahren scheint hier tatsächlich am effektivsten zu sein, hab entsprechend angepasst und noch etwas optimiert:

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:
 
function BerechneWuerfe(AWuerfeAnzahl: Integer): TIntegerDynArray;
const
  Seitenzahl = 6;
var
  i1, i2, i3, n: Integer;
begin
  SetLength(Result, Seitenzahl * AWuerfeAnzahl + 1);
  Result[0] := 1;
  for i1 := 1 to High(Result) do
    Result[i1] := 0;

  for i1 := 1 to AWuerfeAnzahl do
  begin
    n := 0;
    for i2 := High(Result) downto 0 do
    begin
      i3 := i2 - Seitenzahl;
      if i3 >= 0 then
        n := n + Result[i3];
      Result[i2] := n;
      i3 := i2 - 1;
      if i3 >= 0 then
        n := n - Result[i3];
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Anzahl: TIntegerDynArray;
  i, n: Integer;
begin
  Memo1.Lines.Clear;
  Anzahl := BerechneWuerfe(StrToIntDef(Edit1.Text, 0));
  n := 0;
  for i := 0 to High(Anzahl) do
  begin
    Memo1.Lines.Add(IntToStr(i) + ': ' + IntToStr(Anzahl[i]));
    n := n + Anzahl[i];
  end;
  Memo1.Lines.Add('Gesamt: ' + IntToStr(n));
end;


Horst_H - Mi 12.02.14 15:45
Hallo,

nur eine minimale Veränderung spart bis 50% der Berechnungen ( Dreieck statt Rechteck ) von 0+0; 0-0 :

Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
 
  // Setlength initialisiert das Feld zu 0
  SetLength(Result, Seitenzahl * AWuerfeAnzahl + 1);
  Result[0] := 1;
//  for i1 := 1 to High(Result) do  Result[i1] := 0;

  for i1 := 1 to AWuerfeAnzahl do
  begin
    n := 0;
//    for i2 := High(Result) downto 0 do
// Man kann sich auf die notwendigen Felder beschraenken
    for i2 := i1*SeitenZahl downto 0 do
    begin


Bei 14 ist für integer Schluss und bei 27 für Int64.

Gruß Horst
EDIT
user profile iconmandras hat natürlich recht, aber bei der Rekursion, kann man früher Abbrechen.

Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
 
procedure TForm1.Berechne (AnzW, gewAugen:integer; bisher:string);
var k:integer;
begin
 // Wenn nur noch 1 Würfel bleibt und gewAugen im Bereich 1..6,
 // dann besteht die Lösung aus der bisherigen plus <gewAugen>,
 // also dieses ausgeben und schluß.
 // falls gewAugen nicht in 1..6, dann gibt es keine Lösung.
 if (AnzW = 1) then begin
  if (gewAugen in [1..6]) then Memo1.Lines.Add (bisher+inttostr(gewAugen));
  exit;
 end;
 // es sind noch mindestens 2Würfel übrig, also für den ersten die
 // Augenzahl 1..6 durchlaufen und die restl. Würfel mit der
 // um diese reduzierte prüfen
 for k:=1 to 6 do 
   //Wenn es geht, dann weiter suchen
   IF (gewAugen-k) >0 then
     Berechne (AnzW-1, gewAugen-k, bisher+inttostr(k))
   else
   //sonst Schleife abbrechen  
     break;
end;


Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!