UCT--delphi.rar_ UCT_UCT_围棋

电脑围棋的算法UCT语言delphi实现 经过几天的努力，终于实现了uct代码，因为pascal是最优美易懂，适合表达算法的语言，特奉上，有错请大家拍砖，刚入门的爱好者可以修改完善。如有建议，请不吝指教！ unit _XGoUCT; interface uses SysUtils, Classes, windows, _XGoBase; var _UCTMaxSimulation: integer = 100; //这个数越大，深入的层越多！ _UCTMaxTime: cardinal = 5000; //一次着棋的毫秒数 _UCTkomi: double = 2.5; type PNode = ^TNode; TNode = record move: TVertex; wins: double; visits: double; child: array of PNode; bestNode: PNode; end; type TUCT = class(TXGoBase) private UCTk: double; //UCT常数 UCTActivePlayer: shortint; //当前次序 UCTweight: array[0..18, 0..18] of integer; function fCreateChildNodes(const n: PNode): integer; //建立子节点，返回数量 procedure fFreeNodes(const n: PNode); //释放树技 procedure fSetBestNode(const n: PNode); //设置最好的节点 function fPlayRandom: integer; //自由布局 function fUCTSelect(const n: PNode): PNode; //uct选择 function fUCTSimulation(const n: PNode): integer; //模似 function fUCTSearch(const p: Tplayer; const count: integer): TVertex; //搜索 public constructor Create; destructor Destroy; override; function isEye(const i, j: integer; const p: Tplayer): boolean; function getWeight(const x, y: integer): integer; function fCalculate: double; function fgetEmptyVertexs: TVertexs; //获取被压缩的空点 function getEvaluate: double; //评估，返回黑正白负 function PlayMove(const m: TVertex): boolean; function genMove(const p: Tplayer): TVertex; procedure showboard; end; implementation //============================================================================== procedure TUCT.showboard; var i, j, b: integer; c, s, os: string; const topbottom: string = ' A B C D E F G H J K L M N O P Q R S T'; begin os := ''; b := boardsize; writeln(copy(topbottom, 1, 4 + (b - 1) * 2)); for i := 0 to b - 1 do begin s := ''; for j := 0 to b - 1 do begin case Vertexs[i, j] of BLACK: if getmoveLast = char(i) + char(j) then s := s + '◆' else s := s + '●'; WHITE: if getmoveLast = char(i) + char(j) then s := s + '◇' else s := s + '○'; else if (i = 0) then if (j = 0) then c := '┏' else if (j > 0) and (j < b - 1) then c := '┯' else if (j = b - 1) then c := '┓'; if (i > 0) and (i < b - 1) then if (j = 0) then c := '┠' else if (j > 0) and (j < b - 1) then c := '┼' else if (j = b - 1) then c := '┨'; if (i = b - 1) then if (j = 0) then c := '┗' else if (j > 0) and (j < b - 1) then c := '┷' else if (j = b - 1) then c := '┛'; case b of 19: if ((i = 3) and ((j = 3) or (j = b div 2) or (j = b - 4))) or ((i = b div 2) and ((j = 3) or (j = b - 4))) or ((i = b - 4) and ((j = 3) or (j = b div 2) or (j = b - 4))) then c := '╋'; 13: if ((i = 3) and ((j = 3) or (j = b - 4))) or ((i = b - 4) and ((j = 3) or (j = b - 4))) then c := '╋'; end; s := s + c; end; //case end; s := format('%0:2s', [inttostr(b - i)]) + s + inttostr(b - i); writeln(s); end; writeln(copy(topbottom, 1, 4 + (b - 1) * 2)); end; function TUCT.getWeight(const x, y: integer): integer; begin Result := UCTweight[x, y]; end; //============================================================================== constructor TUCT.Create; begin inherited create; UCTk := 1; UCTActivePlayer := BLACK; fillchar(UCTweight, sizeof(UCTweight), 0); end; destructor TUCT.Destroy; begin inherited Destroy; end; //------------------------------------------------------------------------------ function TUCT.isEye(const i, j: integer; const p: Tplayer): boolean; var b: boolean; op: Tplayer; begin if p = BLACK then op := WHITE else op := BLACK; if (i - 1) in [0..BoardSize - 1] then //这一步很重要@~@ b := Vertexs[i - 1, j] = p else b := true; if (i + 1) in [0..BoardSize - 1] then b := b and (Vertexs[i + 1, j] = p); if (j - 1) in [0..BoardSize - 1] then b := b and (Vertexs[i, j - 1] = p); if (j + 1) in [0..BoardSize - 1] then b := b and (Vertexs[i, j + 1] = p); { if ((i - 1) in [0..BoardSize - 1]) and ((j - 1) in [0..BoardSize - 1]) then b := b and (Vertexs[i - 1, j - 1] <> op); if ((i + 1) in [0..BoardSize - 1]) and ((j - 1) in [0..BoardSize - 1]) then b := b and (Vertexs[i + 1, j - 1] <> op); if ((i - 1) in [0..BoardSize - 1]) and ((j + 1) in [0..BoardSize - 1]) then b := b and (Vertexs[i - 1, j + 1] <> op); if ((i + 1) in [0..BoardSize - 1]) and ((j + 1) in [0..BoardSize - 1]) then b := b and (Vertexs[i + 1, j + 1] <> op); }result := b; end; function TUCT.fCalculate: double; //计算胜负，黑为正，白为负,盘面应当为黑里无白，白里无黑的终结场面 var x, y: integer; c: integer; begin c := 0; for x := 0 to BoardSize - 1 do for y := 0 to BoardSize - 1 do case Vertexs[x, y] of BLACK: inc(c); WHITE: dec(c); else if isEye(x, y, BLACK) then inc(c) else dec(c); //判断这个目归属，非黑即白 end; result := c - _uctkomi; end; function TUCT.getEvaluate: double; //评估胜负，黑为正，白为负 var p, v, x, y, m, n, r, i, j, sc: integer; begin sc := 0; fillchar(UCTweight, SizeOf(UCTweight), 0); for x := 0 to boardsize - 1 do for y := 0 to boardsize - 1 do if Vertexs[x, y] <> EMPTY then begin p := 1 - Vertexs[x, y] shl 1; for m := -3 to 3 do begin r := 3 - abs(m); for n := -r to r do begin v := 1 shl (3 - abs(m) - abs(n)); i := x + m; j := y + n; if (i in [0..boardsize - 1]) and (j in [0..boardsize - 1]) then UCTweight[i, j] := UCTweight[i, j] + v * p; end; end; sc := sc + UCTweight[x, y]; end; result := sc - _uctkomi; end; function TUCT.fCreateChildNodes(const n: PNode): integer; //在父节点下面建立很多个子节点,要选择地做点吧，要不还不overflow?!!!＠_＠ var i: integer; s: string; Count: integer; begin result := 0; s := fgetEmptyVertexs; Count := length(s) div 2; setlength(n.child, Count); for i := 0 to Count - 1 do begin new(n.child); n.child.move := s[i * 2 + 1] + s[i * 2 + 2]; n.child.wins := 0; n.child.visits := 0; n.child.bestNode := nil; end; result := Count; end; procedure TUCT.fFreeNodes(const n: PNode); var i: integer; begin if n <> nil then begin for i := 0 to length(n.child) - 1 do fFreeNodes(n.child); setlength(n.child, 0); dispose(n); end; end; function TUCT.fgetEmptyVertexs: TVertexs; //得到可供下子的位置,此函数极为重要，必须大大地降低执行时间 var x, y: integer; ms: TVertexs; begin ms := ''; for x := 0 to BoardSize - 1 do for y := 0 to BoardSize - 1 do if Vertexs[x, y] = EMPTY then ms := ms + xyToVertex(x, y); result := ms; end; procedure TUCT.fSetBestNode(const n: PNode); //设置本节点的bestNode值为本节点的子节点中胜率最大的节点，相同时返回第一个 var i: integer; best: PNode; winrate, bestwinrate: double; begin best := nil; bestwinrate := -1; for i := 0 to length(n.child) - 1 do if n.Child.visits > 0 then begin winr