AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

4-gewinnt Gewinn Überprüfung

Ein Thema von PhilmacFLy · begonnen am 19. Aug 2009 · letzter Beitrag vom 19. Aug 2009
Antwort Antwort
Benutzerbild von PhilmacFLy
PhilmacFLy

Registriert seit: 20. Jan 2008
Ort: Nürnberg
340 Beiträge
 
FreePascal / Lazarus
 
#1

4-gewinnt Gewinn Überprüfung

  Alt 19. Aug 2009, 10:42
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;
Philipp N.
"Programmiern ist wie küssen:
Mann kan darüber reden, mann kann es beschreiben,
aber man weiss erst, was es bedeutet,
wenn man es getan hat"
  Mit Zitat antworten Zitat
Benutzerbild von jfheins
jfheins

Registriert seit: 10. Jun 2004
Ort: Garching (TUM)
4.579 Beiträge
 
#2

Re: 4-gewinnt Gewinn Überprüfung

  Alt 19. Aug 2009, 11:15
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
  Mit Zitat antworten Zitat
alzaimar
(Moderator)

Registriert seit: 6. Mai 2005
Ort: Berlin
4.956 Beiträge
 
Delphi 2007 Enterprise
 
#3

Re: 4-gewinnt Gewinn Überprüfung

  Alt 19. Aug 2009, 11:36
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.
"Wenn ist das Nunstruck git und Slotermeyer? Ja! Beiherhund das Oder die Flipperwaldt gersput!"
(Monty Python "Joke Warefare")
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.105 Beiträge
 
Delphi 12 Athens
 
#4

Re: 4-gewinnt Gewinn Überprüfung

  Alt 19. Aug 2009, 11:39
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)
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 04:11 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz