4-gewinnt Gewinn Überprüfung

[PhilmacFLy]

Hoi DP'ler
bevor ir euch denk schon wieder einer der ne fertige Gewinn überprüfung haben will, sag ich euch gleich das ich keine haben will sondern selber eine geschrieben hab, die wie ich finde eigentlich ziemlich simpel ist. BTW: Ich geh davon aus das das Spielfeld ein 2D Array ist.

Das ganze funktioniert wie folgt:
Im prinzip gibt es bie vier gewinnt nur 4 Richtungen:
rechts - links
oben - unten
linksoben - rechtsunten
rechtsoben - linksunten

Meine Funktion geht nun immer 3 steine nach rechts, und sobald dort einer ind z.B. grün vorliegt wird zu einer Varable 1 dazu gezählt. Das selbe mach ich dann nach links ohne die Variable zu reseten. Diese wird erst beim Richtungswechsel geresetet.
Um nicht in das folgende Problem zu laufen ooxoo, sprich 2 grüne ein roter und wieder 2 grüne, setzt ich einen Boolean der ausagt ob vor dem jetzigen geprüften Stein ein Stein der gleichen Farbe liegt.
Wie der eine oder andere gemerkt hat funktioniert diese Fukntion nur für eine Farbe.

Als fertiger Code sieht das dann so aus:

Delphi-Quellcode:

procedure Tform1.wing(Spalte, Reihe: Integer);
var
r, s, a, w: Integer;
vor: Boolean;
begin
r := Reihe;
s := Spalte;
a := 0;
w := 1;
vor := true;
while w <= 3 do
  begin
  inc(s);
  inc(w);
  if
    (SFeld[s,r] = Green_Spielfeld) and (vor)
  then
    inc(a);
  if
    a = 3
  then
    begin
    showmessage('Sie haben gewonnen Sie Zipfel');
    w := 4;
    end;
  end;
r := Reihe;
s := Spalte;
w := 1;
vor := true;
while w <= 3 do
  begin
  inc(s, -1);
  inc(w);
  if
    (SFeld[s,r] = Green_Spielfeld) and (vor)
  then
    begin
    inc(a);
    vor := true;
    end
  else
    vor := false;
  if
    a = 3
  then
    begin
    showmessage('Sie haben gewonnen Sie Zipfel');
    w := 4;
    end;
  end;

r := Reihe;
s := Spalte;
a := 0;
w := 1;
vor := true;
while w <= 3 do
  begin
  inc(r);
  inc(w);
  if
    (SFeld[s,r] = Green_Spielfeld) and (vor)
  then
    inc(a);
  if
    a = 3
  then
    begin
    showmessage('Sie haben gewonnen Sie Zipfel');
    w := 4;
    end;
  end;
r := Reihe;
s := Spalte;
w := 1;
vor := true;
while w <= 3 do
  begin
  inc(r, -1);
  inc(w);
  if
    (SFeld[s,r] = Green_Spielfeld) and (vor)
  then
    begin
    inc(a);
    vor := true;
    end
  else
    vor := false;
  if
    a = 3
  then
    begin
    showmessage('Sie haben gewonnen Sie Zipfel');
    w := 4;
    end;
  end;

r := Reihe;
s := Spalte;
a := 0;
w := 1;
vor := true;
while w <= 3 do
  begin
  inc(r);
  inc(s);
  inc(w);
  if
    (SFeld[s,r] = Green_Spielfeld) and (vor)
  then
    inc(a);
  if
    a = 3
  then
    begin
    showmessage('Sie haben gewonnen Sie Zipfel');
    w := 4;
    end;
  end;
r := Reihe;
s := Spalte;
w := 1;
vor := true;
while w <= 3 do
  begin
  inc(r, -1);
  inc(s, -1);
  inc(w);
  if
    (SFeld[s,r] = Green_Spielfeld) and (vor)
  then
    begin
    inc(a);
    vor := true;
    end
  else
    vor := false;
  if
    a = 3
  then
    begin
    showmessage('Sie haben gewonnen Sie Zipfel');
    w := 4;
    end;
  end;

r := Reihe;
s := Spalte;
a := 0;
w := 1;
vor := true;
while w <= 3 do
  begin
  inc(r, -1);
  inc(s);
  inc(w);
  if
    (SFeld[s,r] = Green_Spielfeld) and (vor)
  then
    inc(a);
  if
    a = 3
  then
    begin
    showmessage('Sie haben gewonnen Sie Zipfel');
    w := 4;
    end;
  end;
r := Reihe;
s := Spalte;
w := 1;
vor := true;
while w <= 3 do
  begin
  inc(r);
  inc(s, -1);
  inc(w);
  if
    (SFeld[s,r] = Green_Spielfeld) and (vor)
  then
    begin
    inc(a);
    vor := true;
    end
  else
    vor := false;
  if
    a = 3
  then
    begin
    showmessage('Sie haben gewonnen Sie Zipfel');
    w := 4;
    end;
  end;
end;

[jfheins]

Also ich hab' das damals so gemacht:

Delphi-Quellcode:

function TAboutForm.CheckForVictory(Col, Row: Integer): Boolean;
begin
  Result := False;

  // Prüfung auf waagerechte Reihe nach rechts
  if (Col + 3 in [0..6]) and (Row + 0 in [0..4]) and
     (Felder[Col + 1, Row + 0].Tag = CurrPlayer) and
     (Felder[Col + 2, Row + 0].Tag = CurrPlayer) and
     (Felder[Col + 3, Row + 0].Tag = CurrPlayer) then
  begin
    // Gewonnen
    Result := True;
    Exit;
  end;

  // Prüfung auf schräge Reihe nach rechts unten
  if (Col + 3 in [0..6]) and (Row + 3 in [0..4]) and
     (Felder[Col + 1, Row + 1].Tag = CurrPlayer) and
     (Felder[Col + 2, Row + 2].Tag = CurrPlayer) and
     (Felder[Col + 3, Row + 3].Tag = CurrPlayer) then
  begin
    // Gewonnen

    Result := True;
    Exit;
  end;

  // Prüfung auf senkrechte Reihe nach unten
  if (Col + 0 in [0..6]) and (Row + 3 in [0..4]) and
     (Felder[Col + 0, Row + 1].Tag = CurrPlayer) and
     (Felder[Col + 0, Row + 2].Tag = CurrPlayer) and
     (Felder[Col + 0, Row + 3].Tag = CurrPlayer) then
  begin
    // Gewonnen

    Result := True;
    Exit;
  end;

  // Prüfung auf schräge Reihe nach links unten
  if (Col - 3 in [0..6]) and (Row + 3 in [0..4]) and
     (Felder[Col - 1, Row + 1].Tag = CurrPlayer) and
     (Felder[Col - 2, Row + 2].Tag = CurrPlayer) and
     (Felder[Col - 3, Row + 3].Tag = CurrPlayer) then
  begin
    // Gewonnen
    Result := True;
    Exit;
  end;
end;

Und für jedes Feld aufgerufen :angel2:

[alzaimar]

Man benötigt eine explizite 'Gewinn'-Funktion nur selten, da sich der Gewinnn i.A. aus der Stellungsbewertung ergibt. Ein Parameter wäre die Anzahl der ununterbrochenen Reihen einer Farbe. Die folgene Routine berechnet für beide Spieler die Anzahl aller durchgehenden Reihen. Dabei wird jede Reihe mehrfach gezählt, was zum Schluss wieder kompensiert wird.

Nach dem Durchlauf fragt man einfach 'Result[ActivePlayer,4]' ab, wenn 4 Steine zum gewinnen reichen. Die Funktion eignet sich auch für Go-Bang/Gomoku und Tic-Tac-Toe (wofür sie etwas überdimensioniert ist).

Delphi-Quellcode:

Type
  TBoard = Array [0..N-1, 0..N-1] Of TPlayer;
  TRowCountResultArray [TPlayer, 1..N-1] Of Integer;

Procedure CountAllRows (Board :TBoard; Var Results : TRowCountResultArray);
Var
  i,j,d : Integer;
  c : TPlayer;

  Procedure _Count(i0, j0, di, dj : Integer);
  Var
    r, d, i, j : Integer;
    c : TPlayer;
    
  Begin
    r := 1;
    c := Board[i0,j0];
    For d:=0 to 1 do Begin // in beide Richtungen (di,dj und -di, -dj) gehen
      i := i0 + di;
      j := j0 + dj;
      While (i in [0..N-1]) and (j in [0..N-1]) and (Board[i,j] = c) do Begin 
        inc(r);
        inc(i, di); 
        inc(j, dj);
      End;
      di := -di;
      dj := -dj;
    End;
    Inc(Results[c,r]);
  End;
 
      
Begin
  FillChar (Results, SizeOf(Results),0);
  For i:=0 to N-1 do
    For j:=0 to N-1 do
      For d:=0 to 2 do
        _Count(i,j,-1, 2*d-1);

// Jede 2er Reihe wird 2x gefunden, jede 3er Reihe usw.
  For c:=Low(TPlayer) To High (TPlayer) Do
    For i:=1 to N-1 do 
      Results[c,i] := Results[c,i] div i;
End;

getippt und nicht getestet.

[himitsu]

ungetestet, aber sollte funktionieren .... denk ich

Delphi-Quellcode:

type TField = (rNone, rWhite, rBlack);
  TFieldArray = Array[0..6, 0..5] of TField;

function Check(const a: TFieldArray {; Len: Integer}): TField;
var
  x, y, c, r: Integer;
begin
  Result := rNone;
  for x := Low(a) to High(a) do
    for y := Low(a[0]) to High(a[0]) do
      if a[x, y] <> rNone then
      begin
        r := 7;
        for c := 1 to 3 do  //for c := 1 to Len - 1 do
        begin
          if (x + c > High(a)) or (a[x + c, y] <> a[x, y]) then
            r := r and not 1;
          if (y + c > High(a[0])) or (a[x, y + c] <> a[x, y]) then
            r := r and not 2;
          if (x + c > High(a)) or (y + c > High(a[0]))
              or (a[x + c, y + c] <> a[x, y]) then
            r := r and not 4;
        end;
        if r <> 0 then
        begin
          Result := a[x, y];
          exit;
        end;
      end;
end;

Delphi-Quellcode:

var TheField: TFieldArray;

case Check(TheField {, 4}) of
  rWhite: ShowMessage('Weiß hat gewonnen');
  rBlack: ShowMessage('Schwarz hat gewonnen');
end;

[add]
passend zu alzaimar's Post, auch noch Len eingeführt (noch auskommentiert) ... wo man dann die Anzahl der zusammenhängenden Steine angeben könnte

[edit]
kleiner Denkfehler behoben (<= durch > und and durch or ersetzt)