none=0;
black=1;
white=2;

human=1;
random=2;
monteCarlo=3;
alphaBeta=4;
iterativeDeepening=5;
readOut=6;

not[black]=white;
not[white]=black;

reverse[board_,color_,position_,related_]:=Block[{p,direction=Sign[related-position],ret=board},
For[p=position+direction,p≠related,p+=direction,
ret[[Sequence@@p]]=color;
];
Return[ret];
]

related[board_,color_,position_]:=related[board,color,position]=Block[{p,p0,ret={},n=Length[board],cond},
Do[
For[p=p0=position+d,(cond=And@@(1≤#≤n&/@p))&&board[[Sequence@@p]]==not[color],p+=d];
If[cond&&p≠p0&&board[[Sequence@@p]]==color,AppendTo[ret,p]];
,{d,directions}];
Return[ret];
]

put[board_,color_,position_]:=Block[{rltd=related[board,color,position],ret=board},
ret[[Sequence@@position]]=color;
(ret=reverse[ret,color,position,#])&/@rltd;
Return[ret];
]

puttable[board_,color_]:=Select[Position[board,none],related[board,color,#]≠{}&]

passQ[board_,color_]:=puttable[board,color]=={}

children[board_,color_]:=put[board,color,#]&/@puttable[board,color]

score[board_]:=Count[Flatten[board],#]&/@{black,white}

choose[board_,color_,choice_,randomLogQ_:False,positionByHuman_:origin,monteCarloIteration_:-1,evaluationFunction_:Null,alphaBetaDepth_:-1,alphaBetaRandom_:Indeterminate,iterativeDeepeningDepth_:-1,iterativeDeepeningRandom_:Indeterminate,readOutBase_:Indeterminate,readOutThreshold_:-1,readOutRandom_:Indeterminate]:=Switch[choice,
human,positionByHuman,
random,chooseByRandom[board,color,randomLogQ],
monteCarlo,chooseByMonteCarlo[board,color,monteCarloIteration],
alphaBeta,chooseByAlphaBeta[board,color,evaluationFunction,alphaBetaDepth,alphaBetaRandom],
iterativeDeepening,chooseByIterativeDeepening[board,color,evaluationFunction,iterativeDeepeningDepth,iterativeDeepeningRandom],
readOut,chooseByReadOut[board,color,positionByHuman,monteCarloIteration,evaluationFunction,alphaBetaDepth,alphaBetaRandom,iterativeDeepeningDepth,iterativeDeepeningRandom,readOutBase,readOutThreshold,readOutRandom]
]

chooseByRandom[board_,color_,randomLogQ_]:=Block[{list=puttable[board,color]},
If[randomLogQ,log=log<>"list="<>ToString[list]<>"\n"];
Return[RandomChoice[list]];
]

playOut[board_,color_]:=Block[{trn=color,brd=board,scr},
While[True,
If[!passQ[brd,trn],brd=put[brd,trn,choose[brd,trn,random]],If[passQ[brd,not[trn]],Break[]]];
trn=not[trn];
];
scr=score[brd];
Return[
If[color==black,
Piecewise[{{1,scr[[1]]>scr[[2]]},{0,scr[[1]]<scr[[2]]}},1/2]
,
Piecewise[{{1,scr[[1]]<scr[[2]]},{0,scr[[1]]>scr[[2]]}},1/2]
]
];
]

joinChildren[data_,parentIndex_,children_]:=Block[{l,m,ret},
l=Length[data];
m=Length[children];
ret=Join[data,children];
ret[[parentIndex,7]]=Table[l+i,{i,m}];
Return[ret];
]

ucb1[total_,test_,win_]:=If[test==0,∞,N[win/test+Sqrt[2Log[total]/test]]]

maxIndex[list_,indexList_]:=indexList[[First[Ordering[list,-1]]]]

(* data[[node]]={1:board,2:color,3:search,4:reward,5:ucb1,6:parent,7:children} *)
chooseByMonteCarlo[board_,color_,monteCarloIteration_]:=Block[{iteration=monteCarloIteration,threshold=1,node=1,data={{board,color,0,0,Null,0,{}}},chldrn=children[board,color],list=puttable[board,color],nodeChildren,nodeList,poColor,reward},
progress=0;
log=log<>"list="<>ToString[list]<>"\n";
chldrn={#,not[color],0,0,Null,1,{}}&/@chldrn;
data=joinChildren[data,1,chldrn];
While[data[[1,3]]<iteration,
nodeChildren=data[[node,7]];
If[nodeChildren=={},
reward=playOut[data[[node,1]],poColor=data[[node,2]]];
While[node≠1,
data[[node,3]]++;
If[data[[node,3]]==threshold,
chldrn=children[data[[node,1]],data[[node,2]]];
chldrn={#,not[data[[node,2]]],0,0,Null,node,{}}&/@chldrn;
data=joinChildren[data,node,chldrn];
];
If[data[[node,2]]==poColor,data[[node,4]]+=reward,data[[node,4]]+=1-reward];
node=data[[node,6]];
];
data[[1,3]]++;
,
(data[[#,5]]=ucb1[data[[node,3]],data[[#,3]],data[[#,3]]-data[[#,4]]])&/@nodeChildren;
node=maxIndex[data[[#,5]]&/@nodeChildren,nodeChildren];
];
progress=data[[1,3]]/iteration;
];
(*Print[TreePlot[Join@@(Thread[#->data[[#,7]]]&/@Range[Length[data]]),VertexLabeling->True]];*)
(*Print[MatrixForm[{#,data[[#,2]],data[[#,3]],data[[#,4]],Quiet[N[data[[#,4]]/data[[#,3]]]],data[[#,5]]}&/@Range[Length[data]]]];*)
nodeList=Range[Length[list]]+1;
log=log<>"search="<>ToString[data[[nodeList,3]]]<>"\n";
log=log<>"reward="<>ToString[N[data[[nodeList,4]]]]<>"\n";
log=log<>"ratio="<>ToString[Quiet[N[data[[nodeList,4]]/data[[nodeList,3]]]]]<>"\n";
log=log<>"ucb1="<>ToString[data[[nodeList,5]]]<>"\n";
Return[list[[maxIndex[data[[nodeList,3]],nodeList]-1]]];
]

difference[board_,color_]:=Block[{scr=score[board]},
Return[scr[[1]]-scr[[2]]];
]

certain[board_,color_]:=Block[{dimension=Length[Dimensions[board]],l=Length[puttable[board,color]],n=Length[board],corners=Tuples[{1,-1},dimension],scoreCorner=1000,scoreEdge=1,ret=0,colorCorner,sign,p},
Do[
Switch[colorCorner=board[[Sequence@@corner]],
none,Continue[],
black,sign=1,
white,sign=-1
];
ret+=sign scoreCorner;
Do[
For[p=corner+direction,(And@@(-n≤#≤n&/@p))&&board[[Sequence@@p]]==colorCorner,p+=direction,
ret+=sign scoreEdge;
];
,{direction,DiagonalMatrix[corner]}];
,{corner,corners}];
sign=N[If[color==black,1,-1]];
ret+=sign l/n^dimension;
Return[ret];
]

alphaBetaValue[board_,color_,depth_,alpha_,beta_,evaluationFunction_]:=alphaBetaValue[board,color,depth,alpha,beta,evaluationFunction]=Block[{chldrn=children[board,color],α=alpha,β=beta},
If[depth==0,Return[evaluationFunction[board,color]]];
If[Length[chldrn]==0,Return[alphaBetaValue[board,not[color],depth-1,α,β,evaluationFunction]]];
If[color==black,
Do[If[(α=Max[α,alphaBetaValue[child,not[color],depth-1,α,β,evaluationFunction]])≥β,Break[]],{child,chldrn}];
Return[α];
,
Do[If[(β=Min[β,alphaBetaValue[child,not[color],depth-1,α,β,evaluationFunction]])≤α,Break[]],{child,chldrn}];
Return[β];
];
]

chooseByAlphaBeta[board_,color_,evaluationFunction_,alphaBetaDepth_,alphaBetaRandom_]:=Block[{depth=alphaBetaDepth,list=puttable[board,color],l,α=-∞,β=∞,value,order,ret,ctr=1},
progress=0;
log=log<>"list="<>ToString[list]<>"\n";
l=Length[list];
value=ConstantArray[Indeterminate,{l}];
order=If[alphaBetaRandom,RandomSample[Range[l]],Range[l]];
log=log<>"order="<>ToString[order]<>"\n";
If[color==black,
Do[
If[(value[[i]]=alphaBetaValue[put[board,color,list[[i]]],not[color],depth,α,β,evaluationFunction])>α,α=value[[i]];ret=list[[i]];];
progress=ctr++/l;
log=log<>"value[["<>ToString[i]<>"]]="<>ToString[value[[i]]]<>"\n";
,{i,order}];
,
Do[
If[(value[[i]]=alphaBetaValue[put[board,color,list[[i]]],not[color],depth,α,β,evaluationFunction])<β,β=value[[i]];ret=list[[i]];];
progress=ctr++/l;
log=log<>"value[["<>ToString[i]<>"]]="<>ToString[value[[i]]]<>"\n";
,{i,order}];
];
log=log<>"value="<>ToString[value]<>"\n";
Return[ret];
]

chooseByIterativeDeepening[board_,color_,evaluationFunction_,iterativeDeepeningDepth_,iterativeDeepeningRandom_]:=Block[{depth=0,list=puttable[board,color],p=If[color==black,{GreaterEqual,#1[[1,2]]>#2[[1,2]]&},{LessEqual,#1[[1,2]]<#2[[1,2]]&}],l,α,β,value,order,ret},
progress=0;
log=log<>"list="<>ToString[list]<>"\n";
l=Length[list];
value=ConstantArray[Indeterminate,{iterativeDeepeningDepth+1,l}];
order=If[iterativeDeepeningRandom,RandomSample[Range[l]],Range[l]];
While[depth≤iterativeDeepeningDepth,
{α,β}={-∞,∞};
If[color==black,
Do[If[(value[[depth+1,i]]=alphaBetaValue[put[board,color,list[[i]]],not[color],depth,α,β,evaluationFunction])>α,α=value[[depth+1,i]];ret=list[[i]];],{i,order}],
Do[If[(value[[depth+1,i]]=alphaBetaValue[put[board,color,list[[i]]],not[color],depth,α,β,evaluationFunction])<β,β=value[[depth+1,i]];ret=list[[i]];],{i,order}]
];
progress=(depth+1)/(iterativeDeepeningDepth+1);
log=log<>"depth="<>ToString[depth]<>"\t"<>"order="<>ToString[order]<>"\t"<>"value="<>ToString[value[[depth+1]]]<>"\n";
If[depth==iterativeDeepeningDepth,Return[ret]];
order=If[iterativeDeepeningRandom,First[Transpose[Join@@(RandomSample/@Sort[Gather[Transpose[{Range[l],value[[depth+1]]}],#1[[2]]==#2[[2]]&],p[[2]]])]],Ordering[value[[depth+1]],All,p[[1]]]];
depth++;
];
]

readOutValue[board_,color_,alpha_,beta_]:=readOutValue[board,color,alpha,beta]=Block[{chldrn=children[board,color],α=alpha,β=beta},
If[passQ[board,black]&&passQ[board,white],Return[difference[board,color]]];
If[Length[chldrn]==0,Return[readOutValue[board,not[color],α,β]]];
If[color==black,
Do[If[(α=Max[α,readOutValue[child,not[color],α,β]])≥β,Break[]],{child,chldrn}];
Return[α];
,
Do[If[(β=Min[β,readOutValue[child,not[color],α,β]])≤α,Break[]],{child,chldrn}];
Return[β];
];
]

chooseByReadOut[board_,color_,positionByHuman_:origin,monteCarloIteration_:-1,evaluationFunction_:Null,alphaBetaDepth_:-1,alphaBetaRandom_:Indeterminate,iterativeDeepeningDepth_:-1,iterativeDeepeningRandom_:Indeterminate,readOutBase_:Indeterminate,readOutThreshold_:-1,readOutRandom_:Indeterminate]:=Block[{list=puttable[board,color],l,α=-∞,β=∞,value,order,ret,ctr=1},
If[Count[Flatten[board],none]≤readOutThreshold,
progress=0;
log=log<>"list="<>ToString[list]<>"\n";
l=Length[list];
value=ConstantArray[Indeterminate,{l}];
order=If[readOutRandom,RandomSample[Range[l]],Range[l]];
log=log<>"order="<>ToString[order]<>"\n";
If[color==black,
Do[
If[(value[[i]]=readOutValue[put[board,color,list[[i]]],not[color],α,β])>α,α=value[[i]];ret=list[[i]];];
progress=ctr++/l;
log=log<>"value[["<>ToString[i]<>"]]="<>ToString[value[[i]]]<>"\n";
,{i,order}];
,
Do[
If[(value[[i]]=readOutValue[put[board,color,list[[i]]],not[color],α,β])<β,β=value[[i]];ret=list[[i]];];
progress=ctr++/l;
log=log<>"value[["<>ToString[i]<>"]]="<>ToString[value[[i]]]<>"\n";
,{i,order}];
];
log=log<>"value="<>ToString[value]<>"\n";
,
ret=choose[board,color,readOutBase,True,positionByHuman,monteCarloIteration,evaluationFunction,alphaBetaDepth,alphaBetaRandom,iterativeDeepeningDepth,iterativeDeepeningRandom];
];
Return[ret];
]

initialBoard[dimension_,n_,type_]:=Block[{ret},
ret=ConstantArray[none,ConstantArray[n,dimension]];
MapThread[(ret[[Sequence@@(ConstantArray[n/2,dimension]+#1)]]=#2)&,{Tuples[{0,1},dimension],patternList[[type]]}];
Return[ret];
]

boardGraphics[board_,color_,lastPosition_,position_,puttablePosition_,edge_,radius_,opacity_]:=Block[{dimension=Length[Dimensions[board]],list=puttable[board,color],n=Length[board],edgeForm=If[edge,Black,None],p},
Grid[
Reverse[Transpose[
Table[
Graphics[
Table[
p=Take[{i,j,k,l},dimension];
{
If[lastPosition&&p==position,{FaceForm[{Pink,Opacity[opacity]}],EdgeForm[edgeForm],Rectangle[{i,j}]},{FaceForm[{Green,Opacity[opacity]}],EdgeForm[edgeForm],Rectangle[{i,j}]}],
Switch[board[[Sequence@@p]],
none,If[puttablePosition&&MemberQ[list,p],{FaceForm[{LightGreen,Opacity[opacity]}],EdgeForm[edgeForm],Rectangle[{i,j}]}],
black,{FaceForm[Black],EdgeForm[Black],Disk[{i,j}+{1/2,1/2},radius]},
white,{FaceForm[White],EdgeForm[Black],Disk[{i,j}+{1/2,1/2},radius]}
]
},
{i,n},{j,n}]
],
{k,If[dimension≥3,n,1]},{l,If[dimension≥4,n,1]}]
]]
]
]

stateGraphics[board_,color_]:=Block[{scr=score[board],turnGraphics=Graphics[{FaceForm[None],EdgeForm[Black],Rectangle[{-2,-1},{2,1}]}]},
GraphicsGrid[{{
Graphics[{FaceForm[Black],EdgeForm[Black],Disk[]},ImageSize->13],scr[[1]],
Graphics[{FaceForm[White],EdgeForm[Black],Disk[]},ImageSize->13],scr[[2]]
},
If[color==black,{turnGraphics,Null,Null,Null},{Null,Null,turnGraphics,Null}]
}]
]

initialText="Let's Start ReversiND!";

positionText[color_,position_]:=If[color==black,"Black","White"]<>" Player Put "<>ToString[position]

finishText[board_]:=Block[{scr=score[board]},
Piecewise[{{"Black Player Win!",scr[[1]]>scr[[2]]},{"White Player Win!",scr[[1]]<scr[[2]]}},"Draw!"]
]

passText[color_]:=If[color==black,"Black","White"]<>" Player Pass"

initialize[dimension_,n_,type_]:=(
patternList=Permutations[Join@@(ConstantArray[#,2^(dimension-1)]&/@{black,white})];
origin=ConstantArray[0,dimension];
directions=DeleteCases[Tuples[{-1,0,1},dimension],origin];
board=initialBoard[dimension,n,type];
turn=black;
position=origin;
choice=Indeterminate;
text=initialText;
positionByHuman=origin;
progress=0;
log=text<>"\n\n";
);

chooseByHuman[]:=Block[{list=puttable[board,turn]},
log=log<>"list="<>ToString[list]<>"\n";
If[choice==human,
positionByHuman=Take[Join[IntegerPart[MousePosition["Graphics"]],Ceiling[{{1,1},{n,1},{n,n}}[[dimension-1]]MousePosition["EventHandlerScaled"]]],dimension];
If[MemberQ[list,positionByHuman],start=True];
];
];

dimension0=4;
n0=4;
type0=1;
initialize[dimension0,n0,type0];

Manipulate[
Label[begin];
If[start,
If[!passQ[board,turn],
choice=If[turn==black,choiceBlack,choiceWhite];
If[choice==human&&positionByHuman==origin,
start=False;
Goto[begin];
,
position=choose[board,turn,choice,True,positionByHuman,monteCarloIteration,evaluationFunction,alphaBetaDepth,alphaBetaRandom,iterativeDeepeningDepth,iterativeDeepeningRandom,readOutBase,readOutThreshold,readOutRandom];
board=put[board,turn,position];
text=positionText[turn,position];
log=log<>text<>"\n\n";
positionByHuman=origin;
];
,
If[passQ[board,not[turn]],
start=False;
text=finishText[board];
log=log<>text;
Goto[begin];
];
text=passText[turn];
log=log<>text<>"\n\n";
];
turn=not[turn];
];
Dynamic[
TabView[{
"State"->Column[{
Magnify[EventHandler[boardGraphics[board,turn,lastPosition,position,puttablePosition,edge,radius,opacity],{"MouseClicked":>chooseByHuman[]}],{2,2/n,2/n}[[dimension-1]]],
stateGraphics[board,turn],
text,
ProgressIndicator[progress]
},Center],
"Log"->Pane[Pane[Dynamic[log],2000],{400,500},Scrollbars->True,ScrollPosition->{0,10^9}]
},Alignment->Center]
]
,{{start,False,"start"},{True,False}}
,{{resetButton,Null,"reset"},Button["Reset",initialize[dimension,n,type],ImageSize->Automatic]&}
,{{dimension,dimension0,"dimension"},SetterBar[Dynamic[dimension,(dimension=#;type=type0;initialize[dimension,n,type];)&],{2,3,4}]&}
,{{n,n0,"block size"},SetterBar[Dynamic[n,(n=#;initialize[dimension,n,type];)&],{4,6,8}]&}
,{{type,type0,"initial type"},Manipulator[Dynamic[type,(type=#;initialize[dimension,n,type];)&],{1,Length[patternList],1},ImageSize->Small]&}
,{{choiceBlack,random,"black player"},{human->"Human",random->"Random",monteCarlo->"Monte-Carlo",alphaBeta->"Alpha-Beta",iterativeDeepening->"Iterative-Deepening",readOut->"Read-Out"}}
,{{choiceWhite,random,"white player"},{human->"Human",random->"Random",monteCarlo->"Monte-Carlo",alphaBeta->"Alpha-Beta",iterativeDeepening->"Iterative-Deepening",readOut->"Read-Out"}}
,{{seedRandom,Automatic,"random seed"},PopupMenu[Dynamic[seedRandom,(seedRandom=#;SeedRandom[seedRandom];)&],Prepend[Range[0,9],Automatic]]&}
,{{monteCarloIteration,10,"Monte-Carlo iteration"},{10,50,100,500,1000}}
,{{evaluationFunction,certain,"evaluation function"},{difference->"Difference",certain->"Certain"}}
,{{alphaBetaDepth,0,"Alpha-Beta depth"},Range[0,9]}
,{{alphaBetaRandom,True,"Alpha-Beta random"},{True,False}}
,{{iterativeDeepeningDepth,0,"Iterative-Deepening depth"},Range[0,9]}
,{{iterativeDeepeningRandom,True,"Iterative-Deepening random"},{True,False}}
,{{readOutBase,random,"Read-Out base"},{random->"Random",monteCarlo->"Monte-Carlo",alphaBeta->"Alpha-Beta",iterativeDeepening->"Iterative-Deepening"},ControlType->PopupMenu}
,{{readOutThreshold,5,"Read-Out threshold"},Range[5,15]}
,{{readOutRandom,True,"Read-Out random"},{True,False}}
,{board,None}
,{turn,None}
,{position,None}
,{choice,None}
,{text,None}
,{positionByHuman,None}
,{{lastPosition,True,"last position"},{True,False}}
,{{puttablePosition,True,"puttable position"},{True,False}}
,{{edge,True,"edge"},{True,False}}
,{{radius,1/3,"radius"},0,1/2,ImageSize->Small}
,{{opacity,1,"opacity"},0,1,ImageSize->Small}
,SaveDefinitions->True
,SynchronousUpdating->False
]