Sieger-Prüfung "Vier gewinnt"

[Luckie]

Hier im Forum kursieren ja die einige Lösungen. Aber keine befriedigt mich so recht.

Ich habe ein 2D Integer Array mit 7 Spalten und 6 Reihen. 0 steht für leer, 1 für Spieler eins und 2 für Spieler zwei. Dürfte Klar sein, denke ich. Mein Problem, wie überprüfe ich am geschicktesten, ob vier einsen oder vier zweien in einer Reihe sind (auch diagonal)?

Mein Code Rumpf sieht bisher so aus:

Delphi-Quellcode:

function TFourInARow.CheckWinner: Boolean;

  function CheckRow(r: Cardinal): Boolean;
  var
    i: Integer;
    Prev: Integer;
  begin
    result := False;
    for i := ROWS-1 downto 0 do
    begin
      
    end;
  end;

  function CheckColumn(c: Cardinal): Boolean;
  begin
    result := False;
  end;

  function CheckDiagonal: Boolean;
  begin
    result := False;
  end;
  
var
  c, r: Integer;
  FourInARow, FourInAColumn, FourInADiagonal: Boolean;
begin
  for c := 0 to COLUMNS - 1 do
  begin
    FourInAColumn := CheckColumn(c);
  end;
  for r := 0 to ROWS - 1 do
  begin
    FourInARow := CheckRow(r);
  end;
  FourInADiagonal := CheckDiagonal;
  result := FourInAColumn or FourInARow or FourInADiagonal;
end;

Hat irgendjemand eine clevere Idee, wie man die Inline-Funktionen mit Code füllen könnte?

[dizzy]

Ein Schnellschuss: Die Aktuelle Reihe in einen String konvertieren, und nach den Substrings '1111' oder '2222' mit Pos suchen. Das für je alle möglichen Reihen (bei diagonal fallen ja ein paar weg, wo nicht 4 in eine Reihe passen ;))

Weiss nicht wie gut das ist; war die Idee die mir grad spontan kam.

gruss,
dizzy

[Luckie]

Das ist gar nicht mal soooo dumm. Aber irgendwie unelegant, finde ich. Da muss es doch was mathematisches geben.

[w3seek]

wie waers damit?

folgendes mach fuer spieler 1 und 2 getrennt:
du laeufst jede zeile ab, hast einen counter den du anfangs auf null setzt. findest du den spieler, erhoehst du die zahl um 1, ansonsten setz sie zurueck auf 0. wenn am ende 4 rauskommt hast du 4 in einer reihe. das gleiche kannst mit jeder spalte machen und noch diagonal.

[Basilikum]

ich würde etwas in dieser Art verwenden:

Delphi-Quellcode:

Function CheckField(Const Field : Array Of Array Of Byte;Const SameCoinCount : Byte) : Byte;
// Return value: 0 or ID of winning player

Function CheckRow(Const Row : Byte) : Byte;
Var
  X,
  Coin,
  Count : Byte;
Begin
  X:=0;
  While (X <= Length(Field[Row]) - SameCoinCount) Do Begin
    Coin:=Field[Row,X];
    If (Coin = 0) Then Begin
      Inc(X);
      Continue;
    end;

    Count:=1;
    While (X + Count < Length(Field[Row])) and (Field[Row,X + Count] = Coin) Do Inc(Count);

    If (Count >= SameCoinCount) Then Begin
      Result:=Coin;
      Exit;
    end;

    Inc(X,Count);
  end;

  Result:=0;
end;

Var
  X : Byte;
Begin
  For X:=1 To Length(Field) Do Begin
    Result:=CheckRow(X - 1);
    If (Result > 0) Then Exit;
  end;

  Result:=0;
end;

(Analog dazu CheckColumn)

[dizzy]

Hmmm mathematisch... Hab grad ein wenig meinen Kopf um Vektoren und Matrizen schwirren lassen... aber das einzige was mir einfiel ist gleich der Spielsteinzählung, bzw. noch einiges aufwändiger. (Hatte gedacht: Jede Zeile/Spalte als Vektor betrachten und seine Länge berechnen. Ist die = 2 ... aber halt... ne ist auch Quatsch. Dann würde auch 010111 gewinnen... neee neee.)

Hab auch im Netz nichts gefunden wo sich jemand über die Gewinnbedingung explizit auslässt. Ich mutmaße jetzt einfach mal, dass es keine implizite mathematische Lösung dafür gibt, sondern dass da wohl doch ein uneleganter Algorithmus herhalten muss.
So lange du die KI nicht mit verketteten if..then..else machst ist das ja noch locker vertretbar :mrgreen:
(Habe auch für mein Tic Tac Toe die Gewinnbedingung für jede Zeile/Spalte/Diagonale einzeln geprüft - weil ich damals schon nix fand :?)

gruss,
dizzy

[StefanDP]

hi luckie!

ich bin jetzt mal ganz radikal:
mach das alles in EINE prozedur!
alles war du brauchst ist eine weitere information: der ZULETZT gesetzte spielstein!

dnhand diesen spielsteins kannst du dann prüfen ob
- auf einer seite 3 gleiche
- auf einer seite 2 gleiche auf der anderen seite 1 gleicher
("seite" stellvertretend für links/rechts/oben/unten/diagonal

--> fertig!

Delphi-Quellcode:

// Z: Zeile, S: Spalte
function Ist(Spalte, Zeile, Wer: Integer): TRUE;
begin
  // prüfen ob es das Feld gibt und ob es "Wer" (das gleiche) ist
end;

procedure NeuerSpielsteinGesetzt(S, Z, W);
begin
...
  if (Ist(S-3,Z,W) and Ist(S-2,Z,W) and Ist(S-1,Z,W)) or // nach links
     (Ist(S+3,Z,W) and Ist(S+2,Z,W) and Ist(S+1,Z,W)) or // nach rechts
     ...                                              // nach oben/unten/linksoben/rechtsoben...
     (Ist(S-2,Z,W) and Ist(S-1,Z,W) and Ist(S+1,Z,W)) or // 2 links 1 rechts
     ...                                              // 2 rechts 1 links, 2 oben 1 unten usw   
     then
       ShowMessage('Gewonnen mit freundlicher Grüßen von Stefans zugroß geratener If Abfrage ;-)');
end;

ich hoff ihr versteht wie ich das mein

[Luckie]

Zitat:

Zitat von StefanDP

ich hoff ihr versteht wie ich das mein

Also ich nicht. :gruebel:

[Luckie]

So, ich habe jetzt mal w3seeks methode genommen, scheint mir noch am geschicktesten. ASber irgendwo ist da der Wurm drinne. Er findet nur einen Sieger bei der untersten Reihe bzw. bei der recghtesten Spalte. Ich sehe den Wald vor lauter Bäumen nicht mehr:

Delphi-Quellcode:

function TFourInARow.CheckWinnerPlayerOne: Boolean;
var
  c, r: Integer;
  FourInARow, FourInAColumn, FourInADiagonal: Boolean;
  cnt: Integer;

  function CheckRow(r: Cardinal): Boolean;
  var
    i: Integer;
  begin
    cnt := 0;
    for i := 0 to COLUMNS-1 do
    begin
      if Field[i, r] = 1 then
        Inc(cnt)
    end;
    result := cnt = 4;
  end;

  function CheckColumn(c: Cardinal): Boolean;
  var
    i: Integer;
  begin
    cnt := 0;
    for i := 0 to ROWS-1 do
    begin
      if Field[c, i] = 1 then
        Inc(cnt)
    end;
    result := cnt = 4;
  end;

  function CheckDiagonal: Boolean;
  begin
    result := False;
  end;

begin
  for c := 0 to COLUMNS - 1 do
  begin
    FourInAColumn := CheckColumn(c);
  end;
  for r := 0 to ROWS - 1 do
  begin
    FourInARow := CheckRow(r);
  end;
  FourInADiagonal := CheckDiagonal;
  result := FourInAColumn or FourInARow or FourInADiagonal;
end;

Und wenn man das noch etwas vereinfachen könnte, wäre ich auch glücklich.

[Luckie]

Ich habe es jetzt versucht zu vereinfachen, aber ich habe das Gefühl es ist schlimmer geworden und so langsam verliere ich auch die Übersicht. Ich sollte ins Bett gehen. :roll:

Delphi-Quellcode:

function TFourInARow.CheckWinnerPlayerOne: Boolean;
var
  cnt: Integer;

  function CheckRows: Boolean;
  var
    c, r: Integer;
  begin
    cnt := 0;
    for c := 0 to COLUMNS - 1 do
    begin
      for r := 0 to ROWS-1 do
      begin
        if Field[c, r] = 1 then
          Inc(cnt)
      end;
    end;
    result := cnt = 4;
  end;

  function CheckDiagonal: Boolean;
  begin
    result := False;
  end;

begin
  result := CheckRows;
end;

Und im Anhang mal das ganze Projekt.

[w3seek]

Code:

result := cnt = 4;

das sollte >= 4 sein, hab das wort mindestens vergessen. Ich glaub nicht dass man das in eine funktion ohne es total unuebersichtlich zu machen, zusammenfassen kann. Ich wuerde jede zeile und jede spalte checken, und dann noch die diagonalen bei denen mind 4 felder sind. das sollte eigentlich genuegen.

Allerdings find ich auch den Ansatz von StefanDP ganz gut, setzt allerdings voraus dass man dies beim aendern eines Feldes immer prueft, wenn ein fertiges spielfeld vor liegt, wird man das nicht erkennen.

[Luckie]

Äh, ja. Aber wenn in der zweiten Reihe von unten dann 3 sind hat Spieler eins auch gewonnen. Probier es mal aus.

[w3seek]

Code:

    for i := 0 to COLUMNS-1 do
    begin
      if Field[i, r] = 1 then
        Inc(cnt)
      else
        cnt := 0;
    end;

wie gesagt musst du den counter auf null setzen wenn das feld nicht vom gesuchten spieler ist
[edit]
und natuerlich auch fuer jede zeile und spalte wieder auf null setzen
[/edit]

[dizzy]

Ein Problem sehe ich: Eine Zeile/Spalte der Form: 0 1 1 0 0 1 1 würde zu cnt=4 = true führen, obwohl das ja kein Sieg wäre. Es müssen ja nicht nur 4 Steine in einer Zeile/Spalte/Diag. sein, sondern die müssen auch noch lückenlos sein.

Delphi-Quellcode:

function CheckRows: Boolean;
  var
    c, r: Integer;
  begin
    cnt := 0;
    for c := 0 to COLUMNS-1 do
    begin
      for r := 0 to ROWS-1 do
      begin
        if (Field[c, r] = 0) and (cnt > 0) then  // bei Unterbrechung durch '0' zurück setzen!
          cnt := 0
        else if Field[c, r] = 1 then
          Inc(cnt);
      end;
    end;
    result := cnt = 4;
  end;

\\edit: *gnarf* 1.: zu langsam; 2.: nicht so elegant wie w3seek... naja ;)

[Luckie]

@dizzy: jetzt funktioniert gar nichts mehr. Ich habe ja das Projekt angehangen, ihr könnte da ja eure Idee ausprobieren. Ich lass das erstmal liegen für heute und gehe ins Bett, glaube ich.

[dizzy]

SO! Jetzt aber. Das Problem war, dass die Schleife immer bis zum Ende durchlief. Daher fand sie auch NUR Siegbedingungen im letzten Durchgang. Lösung: Ein nicht so schönes, aber wirkungsvoll angebrachtes "exit".

Delphi-Quellcode:

  function CheckRows: Boolean;
  var
    c, r: Integer;
  begin
    for r := 0 to ROWS-1 do
    begin
      cnt := 0;
      for c := 0 to COLUMNS-1 do
      begin
        if Field[c, r] <> 1 then cnt := 0
        else inc(cnt);
        if cnt = 4 then
        begin
          result := true;
          exit;
        end; // if cnt=4
      end; // for c...
    end; // for r...
    result := false;
  end; // CheckRows

(Getestet!)

Für CheckColumns einfach die beiden Schleifenköpfe gegeneinander austauschen, und für Diagonal reicht mein Hirnschmalz heute auch net mehr :)
btw: für ein CheckRows waren die Schleifen ohnehin schon falsch herum verschachtelt! Eigentlich war's schon die CheckColumns :zwinker:.
btw2: das "exit" könnte man jetzt noch umgehen, in dem man das ganze in repeat-until-Schleifen packt, und bei cnt=4 nen Flag setzt. Ist aber imho in diesem Fall nicht viel leichter lesbar, und zu dem weniger performant.

n8i,
dizzy

[w3seek]

Ok, hier mein Algorithmus:

Delphi-Quellcode:

function Gewonnen(Spieler: Byte): Boolean;
const
  N_ZEILEN = 6;
  N_SPALTEN = 7;
  N_GEWINNT = 4;
  Spielfeld: array[0..N_ZEILEN-1] of array[0..N_SPALTEN-1] of Cardinal =
  (
    (0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0)
  );

  function GewinntZeile(Zeile: Integer): Boolean;
  var
    c, i: Integer;
  begin
    Result := false;
    c := 0;
    // wir pruefen alle punkte in dieser zeile
    for i := 0 to N_SPALTEN - 1 do
    begin
      // hat der spieler hier einen punkt?
      if Spielfeld[Zeile][i] = Spieler then
      begin
        // wir zaehlen unseren counter hoch
        Inc(c);
        if c = N_GEWINNT then
        begin
          // wir haben N_GEWINNT aufeinanderfolgendende punkte des spielers, er hat somit gewonnen!
          Result := true;
          Exit;
        end;
      end
      else
      begin
        // dieser punkt ist nicht gesetzt oder gehoert nicht dem spieler! Wir setzen den counter auf 0
        // da die reihe unterbrochen wurde
        c := 0;
      end;
    end;
  end;


  function GewinntSpalte(Spalte: Integer): Boolean;
  var
    c, i: Integer;
  begin
    Result := false;
    c := 0;
    // wir pruefen alle punkte in dieser spalte
    for i := 0 to N_ZEILEN - 1 do
    begin
      // hat der spieler hier einen punkt?
      if Spielfeld[i][Spalte] = Spieler then
      begin
        Inc(c);
        if c = N_GEWINNT then
        begin
          // wir haben N_GEWINNT aufeinanderfolgendende punkte des spielers, er hat somit gewonnen!
          Result := true;
          Exit;
        end;
      end
      else
      begin
        // dieser punkt ist nicht gesetzt oder gehoert nicht dem spieler! Wir setzen den counter auf 0
        // da die reihe unterbrochen wurde
        c := 0;
      end;
    end;
  end;

  function GewinntDiagonal(Zeile, Spalte, Delta: Integer): Boolean;
  var
    Anfang, Pos, Ende: PCardinal;
    c: Integer;
  begin
    Result := false;
    // wir holen uns die adresse des punktes von dem aus wir das spielfeld betrachten, das ist der linke bzw obere spielrand
    Pos := @Spielfeld[Zeile, Spalte];
    // wir holen uns die adressen der punkte ueber bzw unter die wir nicht gehen duerfen
    Anfang := @Spielfeld[0, 0];
    Ende := @Spielfeld[N_ZEILEN - 1][N_SPALTEN - 1];
    c := 0;
    
    // diese schleife so lange ausfuehren bis die aktuelle position ausserhalb des spielfelds gesetzt wurde
    while (Cardinal(Pos) <= Cardinal(Ende)) and (Cardinal(Pos) >= Cardinal(Anfang)) do
    begin
      // ist der gesuchte spieler an der aktuellen stelle?
      if Pos^ = Spieler then
      begin
        // wir zaehlen hoch, wie viele punkte hintereinander schon ohne unterbrechnung waren
        Inc(c);
        if c = N_GEWINNT then
        begin
          // ok, wir haben genau N_GEWINNT punkte in folge, der spieler hat gewonnen!
          Result := true;
          Exit;
        end;
      end
      else
      begin
        // ok, der punkt ist nicht gesetzt oder gehoert nicht zu dem gesuchten spieler, wir setzen den counter zurueck
        c := 0;
      end;
      // wir springen zum naechsten punkt der getestet wird. je nachdem in welche richtung wir gehen und wie weit, gibt delta an.
      Inc(Pos, Delta);
    end;
  end;

var
  i: Integer;
begin
  Result := false;

  // wir laufen von der linken oberen spielecke zur linken unteren spielecke
  for i := 0 to N_ZEILEN - 1 do
  begin
       // sind in dieser zeile 4 aufeinanderfolgende punkte des spielers?
    if GewinntZeile(i) or
       // -(N_SPALTEN - 1) ist der abstand zum naechsten punkt der rechts oben (diagonal) liegt, der abstand ist
       // also negativ und um 1 geringer als das spielfeld spalten hat
       GewinntDiagonal(i, 0, -(N_SPALTEN - 1)) or
       // N_SPALTEN + 1 ist der abstand zum naechsten punkt rechts unten (diagonal), der abstand ist also positiv
       // und um 1 groesser als das spielfeld spalten hat
       GewinntDiagonal(i, 0, N_SPALTEN + 1) then
    begin
      Result := true;
      Exit;
    end;
  end;

  // wir laufen von der linken oberen zur rechten oberen spielecke
  for i := 0 to N_SPALTEN - 1 do
  begin
       // sind in dieser spalte 4 aufeinanderfolgende punkte des spielers?
    if GewinntSpalte(i) or
       // N_SPALTEN + 1 ist der abstand zum naechsten punkt unterhalb und rechts von diesem punkt, also um 1 groesser
       // als das spielfeld spalten hat
       GewinntDiagonal(0, i, N_SPALTEN + 1) or
       // N_SPALTEN - 1 ist der abstand zum naechsten punkt unterhalb und links von diesem punkt, also um genau 1 kleiner
       // als das spielfeld spalten hat
       GewinntDiagonal(0, i, N_SPALTEN - 1) then
    begin
      Result := true;
      Exit;
    end;
  end;
end;

Ich habs nicht ausgiebig getestet, aber sollte funktionieren

[edit]
kleiner fix, es sollte glaub ich "while (Cardinal(Pos) <= Cardinal(Ende)) and (Cardinal(Pos) >= Cardinal(Anfang)) do" statt "while (Cardinal(Pos) < Cardinal(Ende)) and (Cardinal(Pos) >= Cardinal(Anfang)) do" sein
[/edit]

[Luckie]

Oh Gott, wie kommt das den bei mir da jetzt rein? Ich glaube, das muss ich mir noch mal richtig zu Gemühte führen.

[dizzy]

Zitat:

Zitat von Luckie

Oh Gott, wie kommt das den bei mir da jetzt rein? Ich glaube, das muss ich mir noch mal richtig zu Gemühte führen.

Nimm meins - das hab ich in deinem Projekt gebaut und getestet :zwinker:

[Luckie]

Hm, w3seeks Code kompiliert, tut nur nicht das, was ich will. :gruebel:

[dizzy]

:roll: :)

[w3seek]

Zitat:

Zitat von Luckie

Hm, w3seeks Code kompiliert, tut nur nicht das, was ich will. :gruebel:

was meinst du? :?:

[w3seek]

ich schaetze mal es geht nicht weil du in deinem array cardinals verwendet hast....
dann musst du natuerlich die typen korrigieren in der diagonal-test-funktion:

Code:

Anfang, Pos, Ende: PCardinal;

[Luckie]

So, habe es jetzt entsprechen angepasst. Nur bei den Diagonalen haut es nicht ganz hin, die findet er noch nicht.

[w3seek]

siehe post ueber deinem

[Luckie]

Nein das war es auch nicht, aber ich verstehe deinen Trick bei den Diagonalen auch nicht. Wenn du das noch etwas kommentieren könntest bitte.

[dizzy]

Delphi-Quellcode:

  function CheckDiagonal: Boolean;
  var
    i, k, c, r: Integer;
  begin
    c := -2; 
    for i := 0 to 6 do
    begin
      cnt := 0;
      c   := i-2;
      r   := 0;
      for k := 0 to 6 do
      begin
        if (i in [0..COLUMNS-1]) and (k in [0..ROWS-1]) then
        begin
          if Field[c, r] <> 1 then cnt := 0
          else inc(cnt);
          if cnt = 4 then
          begin
            result := true;
            exit;
          end; // if cnt=4
        end; // if (i in ...
        inc(c);
        inc(r);
      end; // for k...
    end; // for i...
    result := false;
  end; // CheckDiagonal

völlig ungetestet!


\\edit: Die beiden 6en in den Schleifen kommen so zu Stande: 6 ist die maximale Länge einer Diagonalen in einem 7x6-Feld, und zufällig sind auch 6 Diagonalen lang genug um 4 Steine aufzunehmen.
\\edit2: diese Funktion ist aber erst für die Diagonalen von links oben nach rechts unten!!! Für die anderen müsste man an den Zählern drehen...

[w3seek]

Zitat:

Zitat von Luckie

Nein das war es auch nicht, aber ich verstehe deinen Trick bei den Diagonalen auch nicht. Wenn du das noch etwas kommentieren könntest bitte.

Habs selbst getestet, geht ganz sicher ;) hab mal den source oben upgedated.

der trick ist der, er geht ja einmal jede zeile durch und er testet dabei diagonal nach oben und unten (delta) ob dort ebenfalls punkte vom spieler gesetzt sind. Delta ist dabei der addressraum der jeweils erhoeht/verniedrigt werden muss um zum naechsten punkt zu gelangen. das gleiche mit den spalten.

[w3seek]

so, ich hoffe das ist ausreichend kommentiert ;-) Man koennte alle 3 funktionen sogar in eine funktion legen, das sieht dann so aus:

Delphi-Quellcode:

function Gewonnen(Spieler: Byte): Boolean;
const
  N_ZEILEN = 6;
  N_SPALTEN = 7;
  N_GEWINNT = 4;
  Spielfeld: array[0..N_ZEILEN-1] of array[0..N_SPALTEN-1] of Cardinal =
  (
    (0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0, 0, 0)
  );

  function GewinntReihe(Zeile, Spalte, Delta, Max: Integer): Boolean;
  var
    Anfang, Pos, Ende: PCardinal;
    c, i: Integer;
  begin
    Result := false;
    // wir holen uns die adresse des punktes von dem aus wir das spielfeld betrachten, das ist der linke bzw obere spielrand
    Pos := @Spielfeld[Zeile, Spalte];
    // wir holen uns die adressen der punkte ueber bzw unter die wir nicht gehen duerfen
    Anfang := @Spielfeld[0, 0];
    Ende := @Spielfeld[N_ZEILEN - 1][N_SPALTEN - 1];
    c := 0;
    i := 0;
   
    // diese schleife so lange ausfuehren bis die aktuelle position ausserhalb des spielfelds gesetzt wurde
    while (Cardinal(Pos) <= Cardinal(Ende)) and (Cardinal(Pos) >= Cardinal(Anfang)) do
    begin
      // ist der gesuchte spieler an der aktuellen stelle?
      if Pos^ = Spieler then
      begin
        // wir zaehlen hoch, wie viele punkte hintereinander schon ohne unterbrechnung waren
        Inc(c);
        if c = N_GEWINNT then
        begin
          // ok, wir haben genau N_GEWINNT punkte in folge, der spieler hat gewonnen!
          Result := true;
          Exit;
        end;
      end
      else
      begin
        // ok, der punkt ist nicht gesetzt oder gehoert nicht zu dem gesuchten spieler, wir setzen den counter zurueck
        c := 0;
      end;
      // wir springen zum naechsten punkt der getestet wird. je nachdem in welche richtung wir gehen und wie weit, gibt delta an.
      Inc(Pos, Delta);
      // fuer zeilen und spalten brauchen wir ein maximum um nicht in die naechste zeile/spalte zu gelangen!
      if Max > 0 then
      begin
        Inc(i);
        // Schleife unterbrechen, wenn wir das Maximum ueberschritten haben
        if i >= Max then
        begin
          Exit;
        end;
      end;
    end;
  end;

var
  i: Integer;
begin
  Result := false;

  // wir laufen von der linken oberen spielecke zur linken unteren spielecke
  for i := 0 to N_ZEILEN - 1 do
  begin
       // sind in dieser zeile 4 aufeinanderfolgende punkte des spielers?
       // der abstand zum naechsten punkt in der zeile ist 1, wir pruefen maximal N_SPALTEN punkte in der zeile
    if GewinntReihe(i, 0, 1, N_SPALTEN) or
       // -(N_SPALTEN - 1) ist der abstand zum naechsten punkt der rechts oben (diagonal) liegt, der abstand ist
       // also negativ und um 1 geringer als das spielfeld spalten hat, wir setzen keine maximale anzahl an punkten die zu pruefen sind, also Max=0
       GewinntReihe(i, 0, -(N_SPALTEN - 1), 0) or
       // N_SPALTEN + 1 ist der abstand zum naechsten punkt rechts unten (diagonal), der abstand ist also positiv
       // und um 1 groesser als das spielfeld spalten hat, wir setzen keine maximale anzahl an punkten die zu pruefen sind, also Max=0
       GewinntReihe(i, 0, N_SPALTEN + 1, 0) then
    begin
      Result := true;
      Exit;
    end;
  end;

  // wir laufen von der linken oberen zur rechten oberen spielecke
  for i := 0 to N_SPALTEN - 1 do
  begin
       // sind in dieser spalte 4 aufeinanderfolgende punkte des spielers?
       // der abstand zum naechsten punkt (der direkt unter dem ausgangspunkt liegt)
       // ist die anzahl der punkte in einer zeile. Wir pruefen nur N_ZEILEN punkte in der spalte!
    if GewinntReihe(0, i, N_SPALTEN, N_ZEILEN) or
       // N_SPALTEN + 1 ist der abstand zum naechsten punkt unterhalb und rechts von diesem punkt, also um 1 groesser
       // als das spielfeld spalten hat, wir setzen keine maximale anzahl an punkten die zu pruefen sind, also Max=0
       GewinntReihe(0, i, N_SPALTEN + 1, 0) or
       // N_SPALTEN - 1 ist der abstand zum naechsten punkt unterhalb und links von diesem punkt, also um genau 1 kleiner
       // als das spielfeld spalten hat, wir setzen keine maximale anzahl an punkten die zu pruefen sind, also Max=0
       GewinntReihe(0, i, N_SPALTEN - 1, 0) then
    begin
      Result := true;
      Exit;
    end;
  end;
end;

[Luckie]

Zitat:

Zitat von w3seek

Zitat:

Zitat von Luckie

Nein das war es auch nicht, aber ich verstehe deinen Trick bei den Diagonalen auch nicht. Wenn du das noch etwas kommentieren könntest bitte.

Habs selbst getestet, geht ganz sicher ;) hab mal den source oben upgedated.

Dank dir, aber dann hab eich es irgendwie falsch eingebaut oder was über sehen. Das aktuelle Projekt hängt ja oben dran.

[supermuckl]

alter geh pennen :D

[w3seek]

Zitat:

Zitat von supermuckl

alter geh pennen :D

Das mach ich jetzt auch, 3 funktionen in 1 gepackt, das ist genug fuer heute ;-)

[StefanDP]

Um nochmal zu meinem Code zurückzukommen!

Code:

function check4(c0,r0,p)
  var 
    i, j, k: Integer;
begom

  // Für den eingeworfenen Stein im Feld (c0,r0) prüfen, ob
  // dieser auf einer Seite drei gleiche Nachbarn ("x" bzw. "o"),
  // oder zwei gleiche Nachbarn auf der einen Seite und
  // einen auf der anderen Seite besitzt.
  for i := -1 to 1 do
    for j := -1 to 1 do
      if (i <> 0) then
        k=0; 
     else 
      begin
        k=1,
        j=1;
       end;
      if(
      Feld("a"+(c0-1*i)+(r0+1*i*j-1*k)) = p and 
      Feld("a"+(c0-2*i)+(r0+2*i*j-2*k)) = p and (
      Feld("a"+(c0-3*i)+(r0+3*i*j-3*k)) = p or
      Feld("a"+(c0+1*i)+(r0-1*i*j+1*k)) = p))
        result := Gewonnen;

end;

... vom prinzip mein code

hab jetzt keine zeit mehr ihn vollstgändig zu überarbeiten (schule...)

[negaH]

Hi Luckie,

mir fallen zwei Lösungen ein die wesentlich performanter als dein Ansatz sein müssen.

1.) wärend des Eintragens eines Zuges eines Spielers, musst du ja in die richtige Spalte/Zeile einen Spielerstein ins Game eintragen. Exakt in diesem Moment, also BEIM Eintragen eines Steines ins Brett (egal ob Spielerzug oder ein Machineller Zug) überprüfst du ob dieser Zug zum 4 gewinnt führt. Dies hat nun mehrere Vorteile:
a.) man überprüft nur EINE Farbe=Spieler, statt beide Spieler
b.) man überprüft ausgehend von der aktuell gesetzten Spieleposition nur 3 Richtungen a 4 Steine, du zählst von der aktuellen Position jeweils in alle Richtung die gleichfarbigen Steine zusammen. Sollte in einer der drei Richtungen >= 4 herauskommen so hat der Zug gewonnen. Die Überprüfungsschritte werden dadurch ganz stark eingeschränkt und durch zusätzliche Informationen = aktuelle Veränderunge am Brett, der Suchraum verkleinert.

2.) Das Brett als solches ist immer gleich. Somit lohnt es sich Konvertierungs-matrixen im Speicher einmalig zu berechen. In diesem Array[] atehen alle Reihen mit mehr als 3 Koordinaten in das Brett. Über diese Martix kann man dann direkt alle Gamepositionen abfragen, in EINER Loop.
Zb. eine Verlinkte Liste aller Positionen auf dem Brett, pro Position jeweils ein Zeiger auf Rechts/Unten/RechtsUnten Position. Nun wird eine Liste aller Anfangsknoten zentral verwaltet. Entstehen wird ein Baum den man nur noch durchgehen muß. Bei dieser Iteration hüpft man von Node zu Node und zählt einen Counter so lange hoch wie es KEINEN Farbwechsel gibt. So bald ein anderer Stein in der Node=Game vorkommt wird dieser Counter=1 gesetzt.

Ich habe hier mal aus meiner 4-Gewinnt Komponente den Zug-Setzen-Algo. rauskopiert:

Delphi-Quellcode:

procedure TGame.SetCell(X,Y: Integer; Value: Integer);
var
  I,SX,EX,SY,EY: Integer;
  Tick: cardinal;
  Wins: Boolean;
begin
  Assert((Value >= gsOne) and (Value <= gsTwo));
  if Value <> FGrid[X, Y] then
  begin
    FGrid[X, Y] := Value;

    if Value <> gsEmpty then
    begin
      Inc(FMoves);

      if goMoveAnimation in FOptions then
        for I := FHeight -1 downto Y +1 do
        begin
          SetControlColor(FShape[X, I], FColor[Value]);
          Tick := GetTickCount + Cardinal(I) * 10;
          while GetTickCount < Tick do Idle;
          SetControlColor(FShape[X, I], FColor[gsEmpty]);
        end;
      SetControlColor(FShape[X, Y], FColor[Value], FMoves);

      if FMoves < FWidth * FHeight then
      begin
      // @Luckie: hier wirds überprüft !! 
      // Grid isn't full
        Wins := True;
      // test horizontal
        SX := X;
        while (SX >= 0) and (FGrid[SX, Y] = Value) do Dec(SX);
        EX := X;
        while (EX < FWidth) and (FGrid[EX, Y] = Value) do Inc(EX);
        Dec(EX, SX);
        if EX <= FStonesInLine then
        begin
        // test vertical
          SY := Y;
          while (SY >= 0) and (FGrid[X, SY] = Value) do Dec(SY);
          EY := Y;
          while (EY < FHeight) and (FGrid[X, EY] = Value) do Inc(EY);
          Dec(EY, SY);
          if EY <= FStonesInLine then
          begin
          // test diagonal from bottomleft to topright
            SX := X;
            SY := Y;
            while (SX >= 0) and (SY >= 0) and (FGrid[SX, SY] = Value) do
            begin
              Dec(SX);
              Dec(SY);
            end;
            EX := X;
            EY := Y;
            while (EX < FWidth) and (EY < FHeight) and (FGrid[EX, EY] = Value) do
            begin
              Inc(EX);
              Inc(EY);
            end;
            Dec(EX, SX);
            if EX <= FStonesInLine then
            begin
            // test diagonal
              SX := X;
              SY := Y;
              while (SX >= 0) and (SY < FHeight) and (FGrid[SX, SY] = Value) do
              begin
                Dec(SX);
                Inc(SY);
              end;
              EX := X;
              EY := Y;
              while (EX < FWidth) and (EY >= 0) and (FGrid[EX, EY] = Value) do
              begin
                Inc(EX);
                Dec(EY);
              end;
              Dec(EX, SX);
              Wins := EX > FStonesInLine;
            end;
          end;
        end;
        if Wins then
          if Value = gsOne then FAction := gaPlayerOneWins
            else FAction := gaPlayerTwoWins;
      end else FAction := gaRemis; // grid full must be a remis
    end else
    begin
      Dec(FMoves);
      SetControlColor(FShape[X, Y], FColor[gsEmpty]);
    end;
  end;
end;

Anbei mal mein angefangenes Projekt. Entpacke es, du installierst die Units NNet.pas und Fourwins.pas als Komponenten. In Fourwins.pas wird eine 4-Gewinnt Komponente installiert, mit Grafischer Komponente + MinMax Algo + Bedienung. Dies Komponente kann nun durch verschiedene Player-Klassen erweitert werden die verschiedene Zug-Such-Strategieen ermöglichen. In NNet.pas findest du ein Neuronales Netz mit dem ich versucht hatte nun einen 4-Gewinnt Neuonal Net Player zu bauen und zu trainieren. Mein Idee dabei war die Netze gegen Menschen, Computer-MinMax-Spieler und anderer NN-Player antreten zu lassen und zu trainieren. Rein theoretisch erhoffte ich mir dadurch ein Neuonales Netz zu trainiert zu bekommen das fast unschlagbar ist.
LEIDER!! bin ich nie so richtig fertig geworden mit dem Ding, und nach 1-2 Wochen Runspielerei verlor ich auch dann die Lust. Ich hoffe du kannst damit was anfangen. Bei Fragen bin ich ja auch noch da ;)

Gruß Hagen

[Ultimator]

Was man nicht alles aus 'nem kleinen 4-Gewinnt-Spiel machen kann :roll: :stupid:

[Luckie]

@hagen, also so extrem wollte ich es dann doch nicht machen. Es reicht mir, wenn ich gegen meine Freundin beim Knobeln regelmäßig verliere, da brauche uich auch nicht noch einen unschlagbaren "Vier gewinnt" Computergegner. Alles was ich jetzt will, ist w3seeks Lösung zum Laufen zu bringen. Aber irgendwas habe ich da wohl bei der Diagonale falsch angepasst oder so. Spalten und Zeilen gehen perfekt.

Da ich der Meinung bin eigentlich nichts übersehen zu haben, würde ich dich, w3seek, noch mal bitten einen Blick auf mein Projekt zu werfen. Das aktuelle ist wieder im Anhang. Dank dir schon mal im Vorraus.

[w3seek]

Zitat:

Zitat von Luckie

Da ich der Meinung bin eigentlich nichts übersehen zu haben, würde ich dich, w3seek, noch mal bitten einen Blick auf mein Projekt zu werfen. Das aktuelle ist wieder im Anhang. Dank dir schon mal im Vorraus.

Dein Feld-array ist statt analog zu meinem Beispiel nicht

Code:

Field: array[0..ROWS - 1, 0..COLUMNS - 1] of Cardinal;

sondern so angeordnet:

Code:

Field: array[0..COLUMNS - 1,0..ROWS - 1] of Cardinal;

D.h. entweder du passt meinen code entsprechend an oder deinen ;)

[Luckie]

Ich meine das hätte ich schon geändert, sonst käme es doch zu einem RangeError.

[w3seek]

So sollte es funktionieren mit deinem programm:

Delphi-Quellcode:

function TFourInARow.Gewonnen(Spieler: Cardinal): Boolean;
const
  N_GEWINNT = 4;

  function GewinntReihe(Spalte, Zeile, Delta, Max: Integer): Boolean;
  var
    Anfang, Pos, Ende: PCardinal;
    c, i: Integer;
  begin
    Result := false;
    // wir holen uns die adresse des punktes von dem aus wir das spielfeld betrachten, das ist der linke bzw obere spielrand
    Pos := @Field[Spalte, Zeile];
    // wir holen uns die adressen der punkte ueber bzw unter die wir nicht gehen duerfen
    Anfang := @Field[0, 0];
    Ende := @Field[COLUMNS - 1][ROWS - 1];
    c := 0;
    i := 0;
   
    // diese schleife so lange ausfuehren bis die aktuelle position ausserhalb des spielfelds gesetzt wurde
    while (Cardinal(Pos) <= Cardinal(Ende)) and (Cardinal(Pos) >= Cardinal(Anfang)) do
    begin
      // ist der gesuchte spieler an der aktuellen stelle?
      if Pos^ = Spieler then
      begin
        // wir zaehlen hoch, wie viele punkte hintereinander schon ohne unterbrechnung waren
        Inc(c);
        if c = N_GEWINNT then
        begin
          // ok, wir haben genau N_GEWINNT punkte in folge, der spieler hat gewonnen!
          Result := true;
          Exit;
        end;
      end
      else
      begin
        // ok, der punkt ist nicht gesetzt oder gehoert nicht zu dem gesuchten spieler, wir setzen den counter zurueck
        c := 0;
      end;
      // wir springen zum naechsten punkt der getestet wird. je nachdem in welche richtung wir gehen und wie weit, gibt delta an.
      Inc(Pos, Delta);
      // fuer zeilen und spalten brauchen wir ein maximum um nicht in die naechste zeile/spalte zu gelangen!
      if Max > 0 then
      begin
        Inc(i);
        // Schleife unterbrechen, wenn wir das Maximum ueberschritten haben
        if i >= Max then
        begin
          Exit;
        end;
      end;
    end;
  end;

var
  i: Integer;
begin
  Result := false;

  // wir laufen von der linken oberen zur rechten oberen spielecke
  for i := 0 to COLUMNS - 1 do
  begin
       // sind in dieser spalte 4 aufeinanderfolgende punkte des spielers?
       // der abstand zum naechsten punkt (der direkt unter dem ausgangspunkt liegt)
       // ist die anzahl der punkte in einer zeile. Wir pruefen nur N_ZEILEN punkte in der spalte!
    if GewinntReihe(i, 0, 1, ROWS) or
       // N_SPALTEN + 1 ist der abstand zum naechsten punkt unterhalb und rechts von diesem punkt, also um 1 groesser
       // als das spielfeld spalten hat, wir setzen keine maximale anzahl an punkten die zu pruefen sind, also Max=0
       GewinntReihe(i, 0, ROWS + 1, 0) or
       // N_SPALTEN - 1 ist der abstand zum naechsten punkt unterhalb und links von diesem punkt, also um genau 1 kleiner
       // als das spielfeld spalten hat, wir setzen keine maximale anzahl an punkten die zu pruefen sind, also Max=0
       GewinntReihe(i, 0, ROWS - 1, 0) then
    begin
      Result := true;
      Exit;
    end;
  end;

  // wir laufen von der linken oberen spielecke zur linken unteren spielecke
  for i := 0 to ROWS - 1 do
  begin
       // sind in dieser zeile 4 aufeinanderfolgende punkte des spielers?
       // der abstand zum naechsten punkt in der zeile ist 1, wir pruefen maximal N_SPALTEN punkte in der zeile
    if GewinntReihe(0, i, ROWS, COLUMNS) or
       // -(N_SPALTEN - 1) ist der abstand zum naechsten punkt der rechts oben (diagonal) liegt, der abstand ist
       // also negativ und um 1 geringer als das spielfeld spalten hat, wir setzen keine maximale anzahl an punkten die zu pruefen sind, also Max=0
       GewinntReihe(0, i, -(ROWS - 1), 0) or
       // N_SPALTEN + 1 ist der abstand zum naechsten punkt rechts unten (diagonal), der abstand ist also positiv
       // und um 1 groesser als das spielfeld spalten hat, wir setzen keine maximale anzahl an punkten die zu pruefen sind, also Max=0
       GewinntReihe(0, i, ROWS + 1, 0) then
    begin
      Result := true;
      Exit;
    end;
  end;
end;

[edit]
die kommentare hab ich aber nicht angepasst :oops:
[/edit]

[Luckie]

Ah, perfekt. Besten herzlichen Dank. Bist schin als Co-Autor im Copyright vermerkt.