Reversi mit KI

[tankm26]

Hallo!

Bei meinem Reversi geht es nun darum eine KI zu programmieren.

In der angehängten Datei fehlt lediglich ein Abbruchskriterium in der function 'bewerte' [glaub' ich]

Wer kann mir mit diesem Problem weiterhelfen?

Es geht darum, in den vorgegebenen Quellcode nun ein Abbruchskriterium einzubauen.

Alle meine bisherigen Versuche endeten mit einem 'Stack-Overflow'.


Der Quellcode:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls;

type
  TForm1 = class(TForm)
    Spielfeld: TStringGrid;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure SpielfeldDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure SpielfeldClick(Sender: TObject);
  private
    { Private declarations }
    procedure pause(zeit:LongInt);
    procedure neu;
    function pruefen(x,y,dx,dy,tiefe:integer):integer;
    procedure umdrehen(x,y,dx,dy,weite,tiefe:integer);
    function istspielfeld(x,y:integer):boolean;
    function punkte(farbe,tiefe:integer):integer;
    function differenz(x,y,farbe,tiefe:integer):integer;
    procedure kopiere(tiefe:integer);
    function bewerte(x,y,farbe,tiefe:integer):integer;
    procedure setze(x,y:integer);
  public
    { Public declarations }
  end;
const
 BREITE=60;
 ANZAHL=5;
 ROT=1;
 BLAU=-1;
 TIEFE=1;
var
  Form1: TForm1;
  feld:array[0..ANZAHL-1,0..Anzahl-1,0..TIEFE] of integer;//0:frei;1:Rot,-1:Blau
  dransein,zahl:integer;

implementation
{$R *.dfm}
procedure TForm1.pause(zeit:LongInt);
var zeit1:LongInt;
begin
  zeit1:=GetTickCount;
  repeat
     Application.ProcessMessages
  until (GetTickCount-zeit1>zeit)
end;

procedure TForm1.kopiere(tiefe:integer);
var i,j:integer;
begin
  for i:=0 to ANZAHL-1 do
    for j:=0 to ANZAHL -1 do
      feld[i,j,tiefe]:=feld[i,j,tiefe-1];
end;

function TForm1.differenz(x,y,farbe,tiefe:integer):integer;
begin
  Result:=punkte(farbe,tiefe)-punkte(-farbe,tiefe);
end;

function TForm1.punkte(farbe,tiefe:integer):integer;
var i,j,zahl:integer;
begin
  zahl:=0;
  for i:=0 to ANZAHL-1 do
    for j:=0 to ANZAHL-1 do
      if feld[i,j,tiefe]=farbe then zahl:=zahl+1;
  Result:=zahl;
end;

function TForm1.istspielfeld(x,y:integer):boolean;
begin
   if ((x>=0) and (x<ANZAHL)) and ((y>=0) and (y<ANZAHL)) then Result:=true
  else Result:=false;
end;

procedure TForm1.umdrehen(x,y,dx,dy,weite,tiefe:integer);
var i:integer;
begin
  if weite>0 then for i:=1 to weite do feld[x+i*dx,y+i*dy,tiefe]:=dransein;
end;

function Tform1.pruefen(x,y,dx,dy,tiefe:integer):integer;
begin
  Result:=-1000;
  if istspielfeld(x+dx,y+dy) then
  begin
    if feld[x+dx,y+dy,tiefe]=-dransein then Result:=pruefen(x+dx,y+dy,dx,dy,tiefe)+1;
    if feld[x+dx,y+dy,tiefe]=dransein then Result:=0;
  end;
end;

procedure TForm1.neu;
var i,j:integer;
begin
  zahl:=0;
  dransein:=ROT;
  for i:=0 to ANZAHL-1 do
    for j:=0 to ANZAHL-1 do
      feld[i,j,0]:=0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  spielfeld.ColCount:=ANZAHL;
  spielfeld.RowCount:=ANZAHL;
  spielfeld.DefaultColWidth:=BREITE;
  spielfeld.DefaultRowHeight:=BREITE;
  spielfeld.Width:=(BREITE+2)*ANZAHL;
  spielfeld.Height:=(BREITE+2)*ANZAHL;
  Form1.Width:=spielfeld.Width+2*spielfeld.Left;
  Form1.Height:=spielfeld.Height+2*spielfeld.Top;
  neu;
end;

function TForm1.bewerte(x,y,farbe,tiefe:integer):integer;
var i,j,dif ,bestx, besty, dif1, dif2:integer;
begin
  Result:=-1000;
  if feld[x,y,tiefe-1]=0 then begin
    kopiere(tiefe);
    feld[x,y,tiefe]:=farbe;
    dif1:=differenz(x,y,farbe,tiefe);
    for i:=-1 to 1 do
      for j:=-1 to 1 do
       umdrehen(x,y,i,j,pruefen(x,y,i,j,tiefe),tiefe);
       //hier die for-schleifen für den besten Gegnerzug
    dif:=-1000;
    for i:=0 to ANZAHL-1 do
      for j:=0 to ANZAHL -1 do
        if bewerte(i,j,-farbe,tiefe+1)>dif then
        begin
          bestx:=i;
          besty:=j;
          dif:=bewerte(bestx,besty,-farbe,tiefe+1);
        end;//Zug setzen
    dif2:=differenz(x,y,farbe,tiefe);
    Result:=((dif2-dif1)div 2)-dif;
  end;
end;

procedure TForm1.setze(x,y:integer);
var i,j:integer;
begin
  zahl:=zahl+1;
  feld[x,y,0]:=dransein;
  for i:=-1 to 1 do
    for j:=-1 to 1 do
      umdrehen(x,y,i,j,pruefen(x,y,i,j,0),0);
  spielfeld.Refresh;
  if dransein=BLAU then dransein:=ROT else dransein:=BLAU;
  if zahl=ANZAHL*ANZAHL then begin
    spielfeld.Enabled:=false;
    Label1.caption:='Es ist unentschieden!:'+IntToStr(punkte(ROT,0))+':'+IntToStr(punkte(BLAU,0));
    if punkte(ROT,0)>punkte(BLAU,0) then Label1.caption:='ROT hat gewonnen';
    if punkte(ROT,0)<punkte(BLAU,0) then Label1.caption:='BLAU hat gewonnen';
  end;
end;

procedure TForm1.SpielfeldDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  case feld[aCol,ARow,0] of
    ROT:begin
      spielfeld.Canvas.Brush.Color:=clRed;
      spielfeld.Canvas.Ellipse((BREITE+1)*ACol,(BREITE+1)*ARow,(BREITE+1)*(ACol+1),(BREITE+1)*(ARow+1));
    end;
    BLAU:begin
      spielfeld.Canvas.Brush.Color:=clBlue;
      spielfeld.Canvas.Ellipse((BREITE+1)*ACol,(BREITE+1)*ARow,(BREITE+1)*(ACol+1),(BREITE+1)*(ARow+1));
    end else begin
      spielfeld.Canvas.Brush.Color:=clCream;
      spielfeld.Canvas.FillRect(Rect);
    end;
  end;
end;

procedure TForm1.SpielfeldClick(Sender: TObject);
var i,j,dif,bestx,besty:integer;
begin
  if feld[spielfeld.Col,spielfeld.Row,0]=0 then
    setze(spielfeld.Col,spielfeld.Row);
  pause(1000);
  if not(zahl=ANZAHL*ANZAHL) then begin  //
    repeat    //suche beliebiges freies Feld
      bestx:=Random(ANZAHL);
      besty:=Random(ANZAHL);
    until feld[bestx,besty,0]=0;
    dif:=bewerte(bestx,besty,dransein,1);
    for i:=0 to ANZAHL-1 do
      for j:=0 to ANZAHL -1 do
        if bewerte(i,j,dransein,1)>dif then
        begin
          bestx:=i;
          besty:=j;
          dif:=bewerte(bestx,besty,dransein,1);
        end;//Zug setzen
    setze(bestx,besty);
  end;
end;

end.

danke schonmal für Ihre/eure Hilfe

Wieland