Sieger-Prüfung "Vier gewinnt"

[w3seek]

Zitat:

Zitat von Luckie

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

lol nicht noetig, ich ueberlass dir den code public domain, meinen namen kannst auch ruhig weglassen, das ist mir eigentlich relativ egal ;)

[Luckie]

Jetzt ist er drinne. In der Aboutbox und im Code als Kommentar zu deiner Funktion. Kuck gleich mal in der Freewaresparte.

[w3seek]

Haettest du Interesse ein Schach-Programm (allerdings ohne KI) (weiter) zu entwickeln? Ich hab vor langer zeit mal ne kleine Schach-Engine entwickelt ;)

[Luckie]

Hm. Ist ja dann wie "Vier Gewinnt" nur etwas komplexer. Ich habe bald etwas mehr zu tun programmiermäßig. Ich denke nicht, dass ich dazu die Zeit hätte. Aber es gibt doch schon ein OpenSource Schachspeil in Delphi. MinMax oder wie das heißt. Kuck dir das doch mal an.

PS: Ist jetzt in der OpenSource Sparte verfügbar.

[w3seek]

*post deleted*

[glkgereon]

boah nee sind die codes lang, machts doch so:

Delphi-Quellcode:

function check4gewinnt(x, y{, spieler}:Byte):boolean //Koordinaten
var
i, j, anzahl:Byte;
gewonnen:boolean;

begin
//reihen
i:=x-4;
anzahl:=0;
while (i<x+5) and (anzahl<4) do begin
   anzahl:=anzahl+1;
   i:=i+1;
   if feld[i,y]<>feld[x,y] then anzahl:=0;
   end;
if anzahl=4 then gewonnen:=true 

//spalten
i:=y-4;
anzahl:=0;
while (i<y+5) and (anzahl<4) do begin
   anzahl:=anzahl+1;
   i:=i+1;
   if feld[x,i]<>feld[x,y] then anzahl:=0;
   end;
if anzahl=4 then gewonnen:=true 


//diagonalen
i:=x-4; j:=y-4;
anzahl:=0;
while (i<x+5) and (j<y+5) and (anzahl<4) do begin
   anzahl1:=anzahl1+1;
   i:=i+1;
   j:=j+1;
   if feld[i,j]<>feld[x,y] then anzahl:=0;
   end;
if anzahl=4 then gewonnen:=true;

i:=x-4; j:=y+4;
anzahl:=0;
while (i<x+5) and (j<y+5) and (anzahl<4) do begin
   anzahl1:=anzahl1+1;
   i:=i+1;
   j:=j-1;
   if feld[i,j]<>feld[x,y] then anzahl:=0;
   end;
if anzahl=4 then gewonnen:=true;

return:=gewonnen;
end;

das is doch wesentlich kürzer, oder???

und es müsste funzen...

also feld ist das feld halt
zweidimensionales array, das mit bytes gefüllt ist...
x und y sind die "koordinaten" des aktuell gesetzten feldes...
mir fällt grad ma so auf dasses so viel kürzer gar nit ist, oder? :gruebel: :gruebel: :gruebel:
und die variable spieler brauch ich gar nit...

[negaH]

Und da du die Variable "gewonnen := true" von einem Test zum nächsten Test erneut setzt, kann man mit deinem Code nur gewinnen wenn in der letzten Diagonalen 4 Steine hat. Doll dat.

Schau dir noch mal meine obigen Source ganz genau an, und vergleiche mal den Assembler-Code den der Compiler erzeugt. Kurzer PASCAL Code muß nicht immer auch effizienteren Machinencode bedeuten.

Zb. sucht deine Routine von x-3 nach x+3 also insgesammt maximal 7 Positionen ab um 4 in einer horz. Line zu messen. Meine Routine sucht von X ausgehend solange nach links und rechts wie auch gleiche Steine dort sitzen. Statt also bei 1 roten Stein im Board denoch 7 Überprüfungen zu machen, benötigt diese Routine 1 Lins + 1 Rechts um festzustellen das es KEINE 4 Steine gleicher Farbe sind.

Wichtig ist dabei immer eines zu bedenken: baut man später eine KI für 4-gewinnt dann ist nämlich diese Zugauswertung die wichtigste Funktion. Sie muß dann so effizient wie möglich gecodet werden.

Klar, über velinkte Gamepositionen könnte man diese Auswertung weit effizienter gestalten, allerdings erhöht sich dann jedesmal der Aufwand des Einfügens eines Steines. Im Falle der Verlinkung sähe der Code etwa so aus:

Delphi-Quellcode:

type
  PGamePos = ^TGamePos;
  TGamePos = packed record
    Stone: Integer;
    Link: array[0..7] of PGamePos;
  end;
  
var
  Game: array[0..6, 0..5] of TGamePos;

const
  StoneInRow = 4;

(*
  Verlinkung -> TGamePos.Link[0..7]
   
   1 2 3
   0 X 4
   7 6 5

   Die diagonalen Verlinkungen in Richtung 1,3,5,7 die in ihrer Verlinkungskette NICHT mindestens 4 Positionen
   enthalten werden alle auf NIL gesetzt.
*)

function Move(X: Integer; Player: Integer): Boolean;

  function DoCount(Pos: PGamePos; Idx, Player: Integer): Boolean;

    function DoCountLink(Pos: PGamePos; Idx, Player: Integer): Integer;
    begin
      Result := 0;
      repeat
        Pos := Pos.Link[Idx];
        if (Pos = nil) or (Pos.Stone <> Player) then Break;
        Inc(Result);
      until Result >= StoneInRow;
    end;

  begin
    Result := DoCountLink(Pos, Idx, Player);
    if Result < StoneInRow then Inc(Result, DoCountLink(Pos, Idx +4, Player));
    Result := Result >= StoneInRow;
  end;

var
  P: PGamePos; 
begin
  P := @Game[X];
  while (P.Stone = Empty) and (P.Link[6] <> nil) do P := P.Link[6];
  P.Stone := Player;
  Result := DoCount(P, 0, Player) or DoCount(P, 1, Player) or DoCount(P, 2, Player) or DoCount(P, 3, Player);
end;

So, das ist aber nun kürzer und effizienter. Es verbleibt nur der EINMALIGE Aufbau der Verlinkungen in Game[].

Gruß Hagen

[negaH]

Es gäbe noch eine effizientere Lösung:

Delphi-Quellcode:

type
  TPlayer = -1..+1;

  PGamePos = ^TGamePos;
  TGamePos = packed record
    Stone: Integer;
    Link: array[0..7] of PGamePos;
  end;

function Move(X: Integer; Player: TPlayer): Boolean;
var
  Pos,Next: PGamePos;
  I,Count: Integer;
begin
  Pos := @Game[0, X];  // Y,X Koordinaten, Y = 0 = oberste Zeile im Game
  while (Pos.Stone = 0) and (Pos.Link[1] <> nil) and (Pos.Link[1].Stone = 0) do Pos := Pos.Link[1];
  Pos.Stone := Player;
  Count := 1;
  for I := 1 to 7 do
  begin
    Next := Pos.Link[I];
    if Next <> nil then
      if Next.Stone = -Player then 
      begin // A)
        Pos.Link[I] := nil;
        if Odd(I) then Next.Link[I -1] := nil
          else Next.Link[I +1] := nil;
      end else
        if Next.Stone = Player then
        begin
          if not Odd(I) then Count := 1;  
          repeat 
            Inc(Count);
            if Count >= StoneInRow then
            begin 
              Result := True;
              Exit;
            end;
            Next := Next.Link[I];
          until (Next = nil) or (Next.Stone <> Player);
        end;  
  end;
  Result := False;
end;

(* Link-Positionen sind nun:
x       x        x        
  6     1      3 

      7 0 2    
x 4   5 x 4    5 x
      3 1 6    
    
  2     0      7
x       x        x  

*)

Obige Methode hat mehrere Neuerungen:

1.) nachdem ein Spielerstein eingefügt wurde werden in allen Richtungen die Verlinkungen auf NIL gesetzt deren Game-Positionen durch Steine des Gegners belegt sind. Dies geschiet im Source bei A). Somit werden nach jedem setzen eines Steines immer mehr Zellen im Game immer weniger Verlinkungen zu ihren Nachbarzellen besitzen. Dies beschleunigt dann die Suche in diese Richtungen. Somit sucht obiger Algo. nur in Richtungen in denen entweder ein Stein des aktuelle Spielers sitzt oder aber noch kein Stein gesetzt wurde.

2.) die Richtungen = Linkpositionen wurden geändert so daß immer zu einer Geradzahligen Richtung die +1 Richtung die Gegenrichtung der Verlinkung darstellt.

Also TGamePos.Link[0] nach Oben, TGamePos.Link[1] nach Unten, TGamePos.Link[4] nach Rechts, TGamePos.Link[5] nach Links.

Somit ist:

P.Link[0].Link[0 +1] = P
P.Link[1].Link[1 -1] = P
P.Link[2].Link[2 +1] = P
P.Link[3].Link[3 -1] = P
P.Link[4].Link[4 +1] = P
P.Link[5].Link[5 -1] = P
P.Link[6].Link[6 +1] = P
P.Link[7].Link[7 -1] = P

3.) wir beginnen unsere Suche erst mit dem Link[1] nach Unten. Den Link[0] nach oben können wir komplett aussparen da ja dort alle LEER sein muß. Auch dies beschleunigt die Suche.

Gruß Hagen

[StefanDP]

Hallo ihr da drausen...

Ihr redet da von "kürzer" und so!
Ich hab mir jetzt mal das Programm von Luckie genommen und die "Gewinnt-Funktion" angepasst!
Sie besteht jetzt nurnoch aus 2 for und 2 if schleifen!!!!!
und damit werden wirklich ALLE in Frage kommenden möglichkeiten getestet, jedoch auch nur die, die wirklich in frage kommen. d.h. keine unnötige prüfung von sinnlosen feldern...

schauts euch an! source ist im anhang.
Achja: Das Programm funzt immer noch ;-)

stefan

Delphi-Quellcode:

function TFourInARow.Gewonnen(Spieler: Cardinal): Boolean;
  function IstFeld(c,r: Cardinal; Spieler: Cardinal): boolean;
  begin
    result := FALSE;
    if not((c > COLUMNS - 1) or    // wenn es das Feld gibt
           (r > ROWS - 1)) then
      if (Field[c,r] = Spieler) then          // und gleiche Farbe ist
        result := TRUE;
  end;
var
  c,r, m,n: Integer;
begin
  Result := FALSE;
  c := Letzter_X;
  r := Letzter_Y;
  for m := -1 to 1 do
    for n := -1 to 1 do
      if not ((m = 0) and (n = 0)) then  // nicht für das eigene feld
        if ((IstFeld( c+   m, r+  n, Spieler)) and
            (IstFeld( c+ 2*m, r+2*n, Spieler)) and
            ((IstFeld(c+ 3*m, r+3*n, Spieler)) or
             (IstFeld(c-   m, r-  n, Spieler)))) then
               Result := TRUE;
end;

PS:
Erklärung:
Ein "4-Gewinnt" Fall tritt nur in 2 verschiedenen Varianten ein:
O### oder #O### (O ist der neu gesetzte, # sind die alten in gleicher farbe)
wenn man diese varianten in alle richtungen dreht und spiegelt (2 for schleifen)
hat man schon das ergebnis!

[Ultimator]

Zitat:

tritt nur in 2 verschiedenen Varianten ein

Und was ist dann mit ##O## ?
das müsste doch dann ein 3. Fall sein, nicht? :gruebel:

[StefanDP]

Zitat:

Zitat von Ultimator

Zitat:

tritt nur in 2 verschiedenen Varianten ein

Und was ist dann mit ##O## ?
das müsste doch dann ein 3. Fall sein, nicht? :gruebel:

nein, funzt auch
weil da ja #0## oder gespiegelt ##0# drinsteckt!

[glkgereon]

nee, noch
ma zu meinem code

was hagen gesagt hat ist QUATSCH!!!!!

ich sage nämlich NICHT

Delphi-Quellcode:

if anzahl=4 then gewonnen:=true
else gewonnen:=false;

SONDERN

Delphi-Quellcode:

if anzahl=4 then gewonnen:=true;

ERST LESEN :warn: :warn: :warn:

[negaH]

@StefanDP:

Ich habe mal deinen Source umgestellt:

Delphi-Quellcode:

function TFourInARow.Gewonnen(Spieler: Cardinal): Boolean; 

  function IstFeld(C, R: Cardinal; Spieler: Cardinal): Boolean; 
  begin 
    Result := (C < COLUMNS) and (R < ROWS) and (Field[C, R] = Spieler); 
  end; 

var 
  C,R,M,N: Integer; 
begin 
  Result := False; 
  C := Letzter_X; 
  R := Letzter_Y; 
  for M := -1 to 1 do 
    for N := -1 to 1 do 
      if (M <> 0) or (N <> 0) then 
        if  IstFeld(C +     M, R +     N, Spieler) and 
            IstFeld(C + 2 * M, R + 2 * N, Spieler) and 
           (IstFeld(C + 3 * M, R + 3 * N, Spieler) or 
            IstFeld(C -     M, R -     N, Spieler)) then 
           Result := True; 
end;

Was mir auffält ist:

1.) IstFeld hat als Übergabeparameter Cardnial und bekommt Integer aus den Schleifen übergeben die -1, -2, -3 sein könnten. Nungut Integer(-1) == Cardinal($100000000 -1) == $FFFFFFFFFF somit dürftest du in der IstFeld-Überprüfung durch einen SEITENEFFEKT des Compilers keine Fehler bekommen. Guter Stil ist das aber nicht.

2.) In den Schleifen überprüfst du IMMER alle möglichen Kombinationen, selbst wenn zB. Result == True ist. Du solltest ein EXIT nach den Result := True machen.

Sollte also so aussehen:

Delphi-Quellcode:

function TFourInARow.Gewonnen(Spieler: Cardinal): Boolean; 

  function IstFeld(C, R: Integer; Spieler: Cardinal): Boolean; 
  begin 
    Result := (C >= 0) and (C < COLUMNS) and (R >= 0) and (R < ROWS) and (Field[C, R] = Spieler); 
  end; 

var 
  C,R,M,N: Integer; 
begin 
  C := Letzter_X; 
  R := Letzter_Y; 
  for M := -1 to 1 do 
    for N := -1 to 1 do 
      if (M <> 0) or (N <> 0) then 
        if  IstFeld(C +     M, R +     N, Spieler) and 
            IstFeld(C + 2 * M, R + 2 * N, Spieler) and 
           (IstFeld(C + 3 * M, R + 3 * N, Spieler) or 
            IstFeld(C -     M, R -     N, Spieler)) then
        begin 
          Result := True; 
          Exit;
        end; 
  Result := False; 
end;

Gruß Hagen

[negaH]

Ok,

[glkgereon]

nein, die schleife bricht ab, wenn anzahl 4 erreicht hat!!!

Zitat:

while (i<y+5) and (anzahl<4) do begin

anzahl wird im durchlauf auf 4 gesetzt, und die schleife bricht ab!!!

:-D :-D *leicht überhebliches grinsen* :-D :-D

[arnoldo]

Also ich würde erstmal einen Ein-Dimensionalen Array anlegen. D.h. das Zeile für Zeile nacheinander gespeichert und durch z.B. eine 0 getrennt wird (wichtig für die Erkennung, ob Rand des Spielfeldes erreicht ist). Dann kann man recht einfach prüfen ob gewonnen wurde, z.B. Bei einem 5x5 grossen Spielfeld die diagonale Prüfung:
-> Wenn Feld[Pos]+Feld[Pos+6]+Feld[Pos+12]+Feld[Pos+18] = 4 Gewonnen!

Code:

var Field: Array[0..63] of Byte;

...

function Test4win(Player, X, Y: Byte): Boolean;

 Function RevTest(Player, Pos, Step: Integer): Byte;
 Begin
  If (Field[Pos]=Player) Then RevTest:=RevTest(Player, Pos+Step, Step)+1
                         Else RevTest:=0;
 End;

Begin
 If (RevTest(Player, Y*8+X, 1) + RevTest(Player, Y*8+X, -1) -1>= 4) or
    (RevTest(Player, Y*8+X, 8) + RevTest(Player, Y*8+X, -8) -1>= 4) or
    (RevTest(Player, Y*8+X, 7) + RevTest(Player, Y*8+X, -7) -1>= 4) or
    (RevTest(Player, Y*8+X, 9) + RevTest(Player, Y*8+X, -9) -1>= 4) Then Test4win:=true
                                                                    Else Test4win:=false;
End;

[Nicodius]

ich würde mal frech gesagt ... das spiel "stoppen" könnnen so das man nicht weiterspielen kann ;)

der code dafür( ;) )

...

Delphi-Quellcode:

var b : boolean = false;

// in der gewinnprocedure 
b := true;

// in der setzprocedure
if b = false then
begin

// in der neues spiel procedure
b := false;

... hoffe geholfen zu haben :P

[Sanchez]

@Nicodius: :gruebel: häh, wie willst du den damit auf die Siegesbedingung stoßen???

[Luckie]

Er meint, dass man bei mir weiterspielen kann, wenn schon jemand gewonnen hat.

aber glaub mir Nicodius, das würde ich noch alleine hinbekommen. ;)

[Nicodius]

hehehe .... *nixmehrsag*


dann machs ;) ich hab dir eh schon den code gegeben ;)


... war ja ein scherz

[Nightshade]

Hab auch noch eine Idee, die das ursprüngliche 2D Array
( 0 = leer, 1 = Spieler 1 , 2 = Spieler 2) nutzt.

Delphi-Quellcode:

var
  daten : array[0..6,0..5] of integer;

function TForm1.Gewonnen:integer;
var tmp1,tmp2 : integer;
begin
  result := 0;

  // Reihen

  for x := 0 to 5 do begin
    tmp1 := 0;
    tmp2 := 0;
    for t := 0 to 6 do begin
      if (daten[t,x] = 1) then tmp1 := tmp1 + trunc(power(2,(t+1)));
      if (daten[t,x] = 2) then tmp2 := tmp2 + trunc(power(2,(t+1)));
    end;
    for t := 0 to 2 do begin
      if ((tmp1 shr t) AND 15) = 15) then result := 1;
      if ((tmp2 shr t) AND 15) = 15) then result := 2;
    end;
  end;

  // spalten

  for t := 0 to 6 do begin
    tmp1 := 0;
    tmp2 := 0;
    for x := 0 to 5 do begin
      if (daten[t,x] = 1) then tmp1 := tmp1 + trunc(power(2,(t+1)));
      if (daten[t,x] = 2) then tmp2 := tmp2 + trunc(power(2,(t+1)));
    end;
    for x := 0 to 2 do begin
      if ((tmp1 shr t) AND 15) = 15) then result := 1;
      if ((tmp2 shr t) AND 15) = 15) then result := 2;
    end;
  end;

  // diagonal SW -> NO

  for u := 3 to 9 do begin
    tmp1 := 0;
    tmp2 := 0;
    for t := 0 to 6 do begin
      x := u - t;
      if ( ( x >= 0 ) AND (x <= 5) ) then begin
        if (daten[t,x] = 1) then tmp1 := tmp1 + trunc(power(2,(t+1)));
        if (daten[t,x] = 2) then tmp2 := tmp2 + trunc(power(2,(t+1)));
      end;
    end;
    for x := 0 to 2 do begin
      if ((tmp1 shr t) AND 15) = 15) then result := 1;
      if ((tmp2 shr t) AND 15) = 15) then result := 2;
    end;
  end;


  // diagonal SO -> NW

  for u := 3 to 9 do begin
    tmp1 := 0;
    tmp2 := 0;
    for t := 0 to 6 do begin
      x := u - (6 - t);
      if ( ( x >= 0 ) AND (x <= 5) ) then begin
        if (daten[t,x] = 1) then tmp1 := tmp1 + trunc(power(2,(t+1)));
        if (daten[t,x] = 2) then tmp2 := tmp2 + trunc(power(2,(t+1)));
      end;
    end;
    for x := 0 to 2 do begin
      if ((tmp1 shr t) AND 15) = 15) then result := 1;
      if ((tmp2 shr t) AND 15) = 15) then result := 2;
    end;
  end;
end;

Rückgabe Wert ist dann 0=keiner, 1=Spieler1, 2=Spieler2