AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Sieger-Prüfung "Vier gewinnt"

Ein Thema von Luckie · begonnen am 28. Jun 2004 · letzter Beitrag vom 30. Jun 2004
Antwort Antwort
Seite 4 von 7   « Erste     234 56     Letzte »    
supermuckl

Registriert seit: 1. Feb 2003
1.340 Beiträge
 
FreePascal / Lazarus
 
#31

Re: Sieger-Prüfung "Vier gewinnt"

  Alt 29. Jun 2004, 02:56
alter geh pennen
Das echte Leben ist was für Leute...
... die im Internet keine Freunde finden!
  Mit Zitat antworten Zitat
w3seek
(Gast)

n/a Beiträge
 
#32

Re: Sieger-Prüfung "Vier gewinnt"

  Alt 29. Jun 2004, 02:58
Zitat von supermuckl:
alter geh pennen
Das mach ich jetzt auch, 3 funktionen in 1 gepackt, das ist genug fuer heute
  Mit Zitat antworten Zitat
StefanDP

Registriert seit: 11. Apr 2004
294 Beiträge
 
#33

Re: Sieger-Prüfung "Vier gewinnt"

  Alt 29. Jun 2004, 06:38
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...)
  Mit Zitat antworten Zitat
Benutzerbild von negaH
negaH

Registriert seit: 25. Jun 2003
Ort: Thüringen
2.950 Beiträge
 
#34

Re: Sieger-Prüfung "Vier gewinnt"

  Alt 29. Jun 2004, 06:45
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
Angehängte Dateien
Dateityp: zip luckie_194.zip (216,6 KB, 16x aufgerufen)
  Mit Zitat antworten Zitat
Benutzerbild von Ultimator
Ultimator

Registriert seit: 17. Feb 2004
Ort: Coburg
1.860 Beiträge
 
FreePascal / Lazarus
 
#35

Re: Sieger-Prüfung "Vier gewinnt"

  Alt 29. Jun 2004, 10:54
Was man nicht alles aus 'nem kleinen 4-Gewinnt-Spiel machen kann
Julian J. Pracht
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#36

Re: Sieger-Prüfung "Vier gewinnt"

  Alt 29. Jun 2004, 11:20
@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.
Angehängte Dateien
Dateityp: zip viergewinnt_422.zip (3,8 KB, 9x aufgerufen)
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
w3seek
(Gast)

n/a Beiträge
 
#37

Re: Sieger-Prüfung "Vier gewinnt"

  Alt 29. Jun 2004, 13:04
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
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#38

Re: Sieger-Prüfung "Vier gewinnt"

  Alt 29. Jun 2004, 13:14
Ich meine das hätte ich schon geändert, sonst käme es doch zu einem RangeError.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
w3seek
(Gast)

n/a Beiträge
 
#39

Re: Sieger-Prüfung "Vier gewinnt"

  Alt 29. Jun 2004, 13:20
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
[/edit]
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#40

Re: Sieger-Prüfung "Vier gewinnt"

  Alt 29. Jun 2004, 13:30
Ah, perfekt. Besten herzlichen Dank. Bist schin als Co-Autor im Copyright vermerkt.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 4 von 7   « Erste     234 56     Letzte »    


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 18:20 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