如何利用遗传算法设计博弈AI

很感谢黄岚老师的帮助，在她的指导下完成了论文的书写工作，现已被Ei检索。

之前有过设计五子棋AI的想法，当时想的运用博弈树，一层一层搜索来完成，我的第一版确实也是这么做的。后来看到这个方法已经烂大街，并且衍生出很多变种，改进也很大，于是尝试着创新。

无意中看到一篇文章：遗传算法：内存中的进化，生动的讲解了什么是遗传算法以及作用，我突然觉得可以拿到设计博弈AI里面去，因为遗传算法就是解决复杂运算的一个简单途径，大量的博弈树的搜索往往是不需要的。

考虑了很久，大致的思路就是把双方的博弈步奏用基因型编码，然后判断当时场上的局面，并尝试量化为适应度函数，基因型的长度和博弈的深度成正比，比如A代表人，B代表电脑，那么基因型编码为ABABAB就代表人和电脑各进行3次博弈，运用适应度函数给出适应值，然后将大量的编码进行遗传迭代，最终选择一个最优解。这个最优解可能不是我方局式最优解，但一定是不让人占上风的解，比如你和别人都可以得到一个完美局势，但是他比你先完成布局，你就应该阻止他完成他的部署，这个过程就要在适应度函数里体现，定一个标准，之后在计算适应度里体现出当前局势的分值，值得说明的是不能仅考虑我方的布局的分值，比如按照一种博弈过程我方形式一片大好，对方却在进行毫无意义的布局那么这个博弈过程显然是失败的，博弈的精髓就是互相考虑双方都发挥最大实力的前提下如何战胜对方。

当然这里面还有多细节问题，比如如何量化各种局势、如何保证最优遗传、甚至如何设计编码的深度都值得认真考虑。这里不再详细说明。

附1.与AI对弈的截图

附2.遗传算法简单框架，以计算以下式子为例：

MAX：f(x,y,z)=sin(x)+(1+cos(y+z))^(2+sin(ln(1+abs(tan(y+z))))/(x+y+1))

unit genetic;

interface
uses System.SysUtils, System.Variants, System.Classes,generics.collections,math;

type
 TChromosome=record              //染色体
 gen:array [0..2] of word ;      //基因
 va:single;                      //表现型
 end;

procedure heaps(list:Tlist<single>);  //内置一个堆排序
function  heapadjust(list:Tlist<single>;s,m:integer):boolean; //堆排序筛选

type
 TGenetic=class
   private
   par:Tlist<TChromosome>;       //父代
   char:Tlist<TChromosome>;      //子代
   geneamount:integer;           //基因规模(长度)
   stablecount:integer;
   procedure value(var sample:TChromosome);              //适应函数
   function  select(pro:array of single):integer;    //选择函数（轮盘赌）
   procedure exc(var p1,p2:TChromosome);                 //染色体交叉，变异
   procedure c_original();
   procedure c_Posterity();
   public
   G_varitionrate:single;    //变异概率
   G_crossrate:single;       //交叉概率
   G_oriamount:integer;      //原始父代数目
   G_popmax:integer;         //种群最大数量
   G_selectpar:integer;      //子代选择数目
   G_genecount:integer;      //种群进化代数
   G_maxevolu:integer;       //最大进化代数
   G_gebest:Tlist<Tchromosome>;   //每代最优解
   G_stablecount:integer;    //稳定遗传
   procedure  G_Evolution(); //进化过程
   constructor create;
 end;

implementation

constructor Tgenetic.create;
begin
  par:=Tlist<Tchromosome>.create;
  char:=Tlist<Tchromosome>.create;
  G_gebest:=Tlist<Tchromosome>.create;
  G_oriamount:=1000;
  G_popmax:=2000;
  G_selectpar:=200;
  G_genecount:=0;
  G_maxevolu:=50;
  geneamount:=10000;
  G_varitionrate:=0.01;
  G_crossrate:=1;
  G_stablecount:=10;  //n代不变则认为稳定
end;

procedure Tgenetic.G_Evolution;
begin
  G_genecount:=0;
  c_original;
  while True do
  begin
   c_Posterity;
   inc(G_genecount);
   G_gebest.Add(par.Items[0]);
    if G_genecount>=G_stablecount then
    if (G_gebest.Items[G_genecount-1].va=G_gebest.Items[G_genecount-G_stablecount].va) then break;
    if G_genecount>=G_maxevolu then  break;
end;
end;

procedure Tgenetic.value(var sample:TChromosome);
var
x,y,z:integer;
begin
  x:=sample.gen[0];
  y:=sample.gen[1];
  z:=sample.gen[2];
  sample.va:=sin(x)+power(1+cos(y+z),2+sin(ln(1+abs(tan(y+z))))/(x+y+1));
  //sample.va:=7*x+ln(y+1)+z;
end;

procedure Tgenetic.c_original;
var
i,J:integer;
s:Tchromosome;
begin
 for I := 1 to G_oriamount do
  begin
  for j := 0 to 2 do
  s.gen[j]:=random(geneamount);
  value(s);
  par.Add(s);
  end;
end;

procedure Tgenetic.c_Posterity;
var
i:integer;
sum:double;
prob:array of single;
index:integer;
p1,p2:Tchromosome;
listpx:Tlist<Tchromosome>;
listv,listv0:Tlist<single>;
begin
  listv:=Tlist<single>.create;
  listv0:=Tlist<single>.create;
  listpx:=Tlist<Tchromosome>.create;
  sum:=0;
  setlength(prob,par.count);  //概率
  for I := 0 to par.count-1 do
    sum:=sum+par.items[i].va;
  for I := 0 to par.count-1 do
    prob[i]:=par.items[i].va/sum;
  index:=1;
  while index<=(G_popmax div 2) do
  begin
   p1:=par.Items[select(prob)];
   p2:=par.Items[select(prob)];
   exc(p1,p2);
   value(p1);
   value(p2);
   char.Add(p1);
   char.Add(p2);
   inc(index);
  end;
  par.Clear;
  for I := 0 to char.Count-1 do
   listpx.Add(char.Items[i]);
  char.Clear;
  for I := 0 to listpx.Count-1 do
  begin
   listv.Add(listpx.Items[i].va);
   listv0.Add(listpx.Items[i].va);
  end;
  heaps(listv);          //堆排序
  for I := listpx.Count-G_selectpar to listpx.Count-1 do
   par.Add(listpx.Items[listv0.IndexOf(listv.Items[i])]);
end;

function Tgenetic.select(pro: array of single):integer;
var
i:integer;
num:double;
sum:double;
areap:array of single;                //轮盘
low,high,mid:integer;
begin
  setlength(areap,length(pro));
  i:=0;
  sum:=0;
  for I := 0 to length(pro)-1 do
  begin
   areap[i]:=sum+pro[i];
   sum:=areap[i];
  end;
  num:=randomrange(1,9999999)/10000000;    //轮盘赌算法
  if (num>=0) and (num<=areap[0]) then
  begin
   result:=0;
   exit;
  end;
  if (num>=areap[length(areap)-1]) and (num<=1) then
  begin
   result:=length(areap)-1;
   exit;
  end;
  low:=1;
  high:=length(areap);
 while(low<=high) do             //折半查找
 begin
  mid:=trunc((low+high)/2);
  if (num>=areap[mid-1]) and (num<=areap[mid]) then
  break;
  if num>=areap[mid-1] then low:=mid
  else high:=mid;
 end;
result:=mid;
end;

procedure Tgenetic.exc(var p1,p2: Tchromosome);
var
exn:integer;
i:integer;
temp:integer;
excr:single;
vari:single;
begin
  exn:=random(3);      //3元
  if G_crossrate>random(1000)/1000 then
   for I := exn to 2 do         //交叉
    begin
    temp:=p1.gen[i];
    p1.gen[i]:=p2.gen[i];
    p2.gen[i]:=temp;
    end;
  excr:=random(10000)/10000;
  if excr<G_varitionrate then    //变异
  begin
   i:=random(3);
   p1.gen[i]:=random(geneamount);
  end;
  if excr<G_varitionrate then    //变异
  begin
   i:=random(3);
   p2.gen[i]:=random(geneamount);
  end;
  p1.va:=0;
  p2.va:=0;
end;

procedure heaps(list:Tlist<single>);
var
i:integer;
temp:real;
begin
i:=list.Count div 2;
while i>0 do                             //建成大顶堆
  begin
  heapadjust(list,i,list.Count-1);
  dec(i);
  end;
i:=list.Count;
while i>1 do
  begin
  temp:=list.Items[0];
  list.Items[0]:=list.Items[i-1];
  list.Items[i-1]:=temp;
  heapadjust(list,1,i-1);
  dec(i);
  end;
end;

function heapadjust(list: TList<System.single>; s: Integer; m: Integer):boolean;
var j:integer;
    temp:real;
begin
temp:=list.Items[s-1];
j:=2*s;
while (j<=m) do
  begin
  if (j<m)and(list.Items[j-1]<list.Items[j]) then
  inc(j);
  if temp>=list.Items[j-1] then
  break;
  list.Items[s-1]:=list.Items[j-1];
  s:=j;
  j:=2*j;
  end;
  list.Items[s-1]:=temp;
end;

end.