Alle Kombinationsmöglichkeiten der Würfel ermitteln

florida · Verfasst: So 09.02.14 19:43

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

markieren

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

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:

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 · Verfasst: So 09.02.14 22: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:

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:

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 · Beiträge: 174 Erhaltene Danke: 43

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.

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:

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;

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:

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 · Verfasst: Mo 10.02.14 21:26

Wenn ich florida richtig verstanden habe ging um N Würfel und nicht um N Würfe

Horst_H · Verfasst: Mo 10.02.14 22: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.

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:

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.

markieren

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 · Verfasst: Di 11.02.14 11:20

Hallo,

der Code-Schnipsel von user profile icon

Blup scheint mir etwas merkwürdig.
Im Prinzip zerlegt er die Kombinationsnummer in eine Wurf aus AWuerfeAnzahl Wuerfen eines Wuerfels.
Das wäre aber so:

markieren

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 · Beiträge: 174 Erhaltene Danke: 43

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

markieren

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 · Verfasst: Di 11.02.14 20: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 · Beiträge: 174 Erhaltene Danke: 43

Das Additionsverfahren scheint hier tatsächlich am effektivsten zu sein, hab entsprechend angepasst und noch etwas optimiert:

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:

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 · Verfasst: Mi 12.02.14 16:45

Hallo,

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

markieren

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 icon

mandras hat natürlich recht, aber bei der Rekursion, kann man früher Abbrechen.

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:

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;

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme