Panel[
Grid[
{{Column[{
initializeButton,
Deploy[
Grid[{
{player1Panel,
player2Panel,
labelPanel},
{latticePanel,
dynamicsPanel,
SpanFromLeft},
{infoPanel,
SpanFromLeft},
{controlPanel,
SpanFromLeft}},
Spacings->{1,1},
Alignment->{Left,Top}]],
Deploy[Style["Copyleft 2012 Panayotis Mertikopoulos; all wrongs reserved.",10]]},
Alignment->Left,
Spacings->{Automatic,{3->1}}],
Panel[
graph,
ImageSize->600]}}],
BaseStyle->GUIStyle]

Function Library

Basic Functions

Expit[x_]:=1/(1+Exp[-x]);
Logit[x_]:=Log[x]-Log[1-x];

Property Tags

ImitationQ[dynamics_String]:=False;

OnlyInteriorRestpointsQ[dynamics_String]:=False;

Brown–von Neumann–Nash dynamics

BNNField[game_,vec_]:=Module[
{U1=game[[1]],U2=game[[2]],
x=vec[[1]],y=vec[[2]]},
{(((1-x))^2)Max[{1,-1}.U1.{y,1-y},0]+(x^2)Min[{1,-1}.U1.{y,1-y},0],
(((1-y))^2)Max[{x,1-x}.U2.{1,-1},0]+(y^2)Min[{x,1-x}.U2.{1,-1},0]}];

BNNScoreField[game_,vec_]:=Module[
{U1=game[[1]],U2=game[[2]],
x=vec[[1]],y=vec[[2]]},
{((1-x)/x)Max[{1,-1}.U1.{y,1-y},0]+(x/(1-x))Min[{1,-1}.U1.{y,1-y},0],
((1-y)/y)Max[{x,1-x}.U2.{1,-1},0]+(y/(1-y))Min[{x,1-x}.U2.{1,-1},0]}];

Entropic dynamics

EntropicField[game_,vec_,temperature_:1]:=Module[
{U1=game[[1]],U2=game[[2]],
x=vec[[1]],y=vec[[2]]},
{x(1-x)({1,-1}.U1.{y,1-y}-temperature Logit[x]),
y(1-y)({x,1-x}.U2.{1,-1}-temperature Logit[y])}]

EntropicScoreField[game_,vec_,temperature_:1]:=Module[
{U1=game[[1]],U2=game[[2]],
x=vec[[1]],y=vec[[2]]},
{{1,-1}.U1.{y,1-y}-temperature Logit[x],
{x,1-x}.U2.{1,-1}-temperature Logit[y]}]

ImitationQ["Entropic"]:=True;

OnlyInteriorRestpointsQ["Entropic"]:=True;

Imitative Logit dynamics

ImitativeLogitField[game_,vec_,temperature_:1]:=Module[
{U1=game[[1]],U2=game[[2]],
x=vec[[1]],y=vec[[2]]},
{(x/(x+(1-x)Exp[{-1,1}.U1.{y,1-y}/temperature]))-x,
(y/(y+(1-y)Exp[{x,1-x}.U2.{-1,1}/temperature]))-y}];

ImitativeLogitScoreField[game_,vec_,temperature_:1]:=Module[
{U1=game[[1]],U2=game[[2]],
x=vec[[1]],y=vec[[2]]},
{((1-Exp[{-1,1}.U1.{y,1-y}/temperature])/(x+(1-x)Exp[{-1,1}.U1.{y,1-y}/temperature])),
((1-Exp[{x,1-x}.U2.{-1,1}/temperature])/(y+(1-y)Exp[{x,1-x}.U2.{-1,1}/temperature]))}];

ImitationQ["ImitativeLogit"]:=True;

Maynard Smith dynamics

MaynardSmithField[game_,vec_]:=Module[
{U1=game[[1]],U2=game[[2]],
x=vec[[1]],y=vec[[2]]},
{x(1-x){1,-1}.U1.{y,1-y}/{x,1-x}.U1.{y,1-y},
y(1-y){x,1-x}.U2.{1,-1}/{x,1-x}.U2.{y,1-y}}]

MaynardSmithScoreField[game_,vec_]:=Module[
{U1=game[[1]],U2=game[[2]],
x=vec[[1]],y=vec[[2]]},
{{1,-1}.U1.{y,1-y}/{x,1-x}.U1.{y,1-y},
{x,1-x}.U2.{1,-1}/{x,1-x}.U2.{y,1-y}}]

ImitationQ["MaynardSmith"]:=True;

Logit dynamics

LogitField[game_,vec_,temperature_:1]:=Module[
{U1=game[[1]],U2=game[[2]],
x=vec[[1]],y=vec[[2]]},
{Expit[{1,-1}.U1.{y,1-y}/temperature]-x,
Expit[{x,1-x}.U2.{1,-1}/temperature]-y}];

LogitScoreField[game_,vec_,temperature_:1]:=Module[
{U1=game[[1]],U2=game[[2]],
x=vec[[1]],y=vec[[2]]},
{Expit[{1,-1}.U1.{y,1-y}/temperature]-x,
Expit[{x,1-x}.U2.{1,-1}/temperature]-y}];

OnlyInteriorRestpointsQ["Logit"]:=True;

Replicator dynamics

ReplicatorField[game_,vec_]:=Module[
{U1=game[[1]],U2=game[[2]],
x=vec[[1]],y=vec[[2]]},
{x(1-x){1,-1}.U1.{y,1-y},
y(1-y){x,1-x}.U2.{1,-1}}]

ReplicatorScoreField[game_,vec_]:=Module[
{U1=game[[1]],U2=game[[2]],
x=vec[[1]],y=vec[[2]]},
{{1,-1}.U1.{y,1-y},
{x,1-x}.U2.{1,-1}}]

ImitationQ["Replicator"]:=True;

Smith dynamics

SmithField[game_,vec_]:=Module[
{U1=game[[1]],U2=game[[2]],
x=vec[[1]],y=vec[[2]]},
{(1-x)Max[{1,-1}.U1.{y,1-y},0]+x Min[{1,-1}.U1.{y,1-y},0],
(1-y)Max[{x,1-x}.U2.{1,-1},0]+y Min[{x,1-x}.U2.{1,-1},0]}];

SmithScoreField[game_,vec_]:=Module[
{U1=game[[1]],U2=game[[2]],
x=vec[[1]],y=vec[[2]]},
{Max[{1,-1}.U1.{y,1-y},0]/x+ Min[{1,-1}.U1.{y,1-y},0]/(1-x),
Max[{x,1-x}.U2.{1,-1},0]/y+ Min[{x,1-x}.U2.{1,-1},0]/(1-y)}];

Dynamics display

DisplayField[dynamics_]:=
FullSimplify[
Switch[
dynamics,
"Replicator",
ReplicatorField[game,{x,y}],
"MaynardSmith",
MaynardSmithField[game,{x,y}],
"Entropic",
EntropicField[game,{x,y},temperature],
"Smith",
SmithField[game,{x,y}],
"BNN",
BNNField[game,{x,y}],
"Logit",
LogitField[game,{x,y},temperature],
"ImitativeLogit",
ImitativeLogitField[game,{x,y},temperature],
"Custom",
CustomField[x,y]],
0≤x≤1&&0≤y≤1];

Initialization and Controls

Game

game={0,0};
game[[1]]={{1,-1},{-1,1}};
game[[2]]={{-1,1},{1,-1}};

Dynamics

dynamics="Replicator";
order=1;
temperature=1;

xDisplayField=Dynamic[Rationalize[DisplayField[dynamics][[1]]]];
yDisplayField=Dynamic[Rationalize[DisplayField[dynamics][[2]]]];

xCustomField=0;
yCustomField=0;
CustomField[x_,y_]:={xCustomField,yCustomField};
CustomScoreField[x_,y_]:={xCustomField,yCustomField};

time=5;
resolution=300;
plotclip=20.;
plotchop=10^-6;

Bounding box

boundaryFlag=True;
boundary={};

boundaryColor=Black;
boundaryThickness=1;

Labels

labelsFlag=True;
labels={};

plotLabel="Plot Title";
xLabel = "x";
yLabel = "y";
frameLabel={
{Style[Dynamic[yLabel],FontSize->18],
None},
{Style[Dynamic[xLabel],FontSize->18],
Style[Dynamic[plotLabel],Bold,FontSize->Large]}};

Initial points

latticeFlag=True;
lattice={};

dx=.2;
dy=.2;
standardLatticePoints=Flatten[Table[Rationalize[{x,y}],{x,0,1,dx},{y,0,1,dy}],1];

dxCustom=.1;
dyCustom=.1;
nRandomPoints=20;
customLatticePoints=standardLatticePoints;

customLatticeQ=False;
latticePoints=standardLatticePoints;

latticePointColor=Darker[Gray];
latticePointStyle={latticePointColor,PointSize[Medium]};

Gridlines

gridFlag=True;
grid={};

gridColor=Darker[Gray];
gridStyle={DotDashed,gridColor,AbsoluteThickness[.75]};

xtick=.2;
ytick=.2;

Nash Equilibria

equilibriumFlag=True;
equilibria={};
equilibriumData={};

equilibriumColor=Darker[Red];
equilibriumThickness=2.5;

Rest points

calculateRestpointsFlag=True;
showRestpointsFlag=True;
restpoints={};
restpointsData={};

restColor=ColorData[1,1];

Orbits

calculateOrbitsFlag=True;
showOrbitsFlag=True;
orbits={};
orbitsData={};

orbitsColor=ColorData[1,4];
orbitsThickness=AbsoluteThickness[.75];
orbitStyle={orbitsColor,orbitsThickness};

Vectors

calculateVectorsFlag=True;
showVectorsFlag=True;
vectors={};

vectorColor=GrayLevel[.25];
vectorThickness=1;
vectorLength=1;

Graph

emptyGraph=Show[
Graphics[
Text[
Style[
"Choose game and dynamics parameters, then click on 'Update Graph'.
Control the display options by checking the appropriate checkboxes.
To restart, click on 'Initialize GameSeer'.",
FontFamily->GUIFont,FontSize->14],{1/2,1/2}]],
Background->White,
ImageSize->Full,
Frame->True,
FrameLabel->frameLabel,
BaseStyle->{FontFamily->"Times",FontSize->14},
PlotRange->{{-.02,1.02},{-.02,1.02}}];
graph=emptyGraph;
graphData=Graphics[
Text[
Style[
"Choose game and dynamics parameters, then click on 'Update Graph'.
Control the display options by checking the appropriate checkboxes.
To restart, click on 'Initialize GameSeer'.",
FontFamily->GUIFont,FontSize->14],{1/2,1/2}]];

GUI Appearance

GUIFont="Palatino";
GUIStyle={FontFamily->GUIFont,13};

GUI Elements

Initialize GUI

initializeButton=Deploy[
DefaultButton[
Style["Initialize GameSeer",FontFamily->GUIFont,FontSize->Large,Bold],FrontEndExecute[FrontEndToken["EvaluateInitialization"]];
NotebookLocate["GameSeer"];
FrontEndExecute[FrontEndToken["Evaluate"]],
FrameMargins->7,
Alignment->{Bottom,Bottom}]];

Payoffs

player1Panel=Deploy[
Panel[
Grid[{
{Style["Payoffs for Player 1",Bold],
SpanFromLeft},
{InputField[Dynamic[game[[1,1,1]]],ImageSize->{40,25}],InputField[Dynamic[game[[1,1,2]]],ImageSize->{40,25}]},{InputField[Dynamic[game[[1,2,1]]],ImageSize->{40,25}],InputField[Dynamic[game[[1,2,2]]],ImageSize->{40,25}]}},
Spacings->{Automatic,2->.75},
Alignment->Center,
BaseStyle->GUIStyle],
ImageSize->{150,100},
Alignment->{Left,Top}]];

player2Panel=Deploy[
Panel[
Grid[{
{Style["Payoffs for Player 2",Bold],
SpanFromLeft},
{InputField[Dynamic[game[[2,1,1]]],ImageSize->{40,25}],InputField[Dynamic[game[[2,1,2]]],ImageSize->{40,25}]},{InputField[Dynamic[game[[2,2,1]]],ImageSize->{40,25}],InputField[Dynamic[game[[2,2,2]]],ImageSize->{40,25}]}},
Spacings->{Automatic,2->.75},
Alignment->Center,
BaseStyle->GUIStyle],
ImageSize->{150,100},
Alignment->{Left,Top}]];

Plot Labels

labelPanel=Deploy[
Panel[
Grid[{
{Style["Plot Labels",Bold],
SpanFromLeft},
{Style["Title",12],
InputField[Dynamic[plotLabel],String,ImageSize->{150,25},
FieldHint->"Plot Title"],
SpanFromLeft},
{Style["x label",12],
InputField[Dynamic[xLabel],String,ImageSize->{44,25},
FieldHint->"x label"], 
Style["y label",12],
InputField[Dynamic[yLabel],String,ImageSize->{45,25},
FieldHint->"y label"]}},
Spacings-> {1,{2->.75}},
Alignment->Left,
BaseStyle->GUIStyle],
ImageSize->{230,100},
Alignment->{Left,Top}]];

Initial points

customInitialGridCheckbox=Grid[
{{Deploy[
Checkbox[Dynamic[customLatticeQ]]],
"Custom"}},
Alignment->Baseline];

randomInitialConditionsButton=Deploy[
Button[
Style["Use random",FontFamily->GUIFont],
customLatticePoints=Table[{Random[],Random[]},{nRandomPoints}],
ImageSize->{100,30}]];

interiorGridInitialConditionsButton=Deploy[
Button[
Style["Use int. grid",FontFamily->GUIFont],
customLatticePoints=Flatten[
Table[
{x,y},
{x,dxCustom,1-dxCustom,2dxCustom},
{y,dyCustom,1-dyCustom,2dyCustom}],
1],
ImageSize->{100,30}]];

customInitialConditionsDialog=
Deploy[
Panel[
Grid[{
{Grid[{
{Style["Customized Initial Conditions",FontFamily->GUIFont,14,Bold],
SpanFromLeft},
{"Enter a table of initial points or choose from below:",
SpanFromLeft},
{"Random",
InputField[Dynamic[nRandomPoints],Number,ImageSize->{40,25},FieldHint->"#"],
SpanFromLeft,
randomInitialConditionsButton},
{"Interior Grid",
InputField[Dynamic[dxCustom],ImageSize->{40,25},FieldHint->"dx"],
InputField[Dynamic[dyCustom],ImageSize->{40,25},FieldHint->"dy"],
interiorGridInitialConditionsButton},
{InputField[Dynamic[customLatticePoints],ImageSize->{300,200}],
SpanFromLeft}},
Spacings->{Automatic,{2->2,5->1}},
Alignment->{Left,Center}],
Dynamic[
Show[boundary,grid,
Graphics[
Table[
Append[
latticePointStyle,Point[point]],
{point,customLatticePoints}]],
ImageSize->320]],
SpanFromLeft}},
Alignment->{Left,Bottom},
Spacings->{
Automatic,
{2->5,3->1}},
BaseStyle->GUIStyle]]];

customInitialConditionsButton=Deploy[
Button[
Style["Choose Points",FontFamily->GUIFont],
CreateWindow[
DialogNotebook[customInitialConditionsDialog]]]];

latticePanel=Deploy[
Panel[
Grid[{
{Style["Initial Points",FontFamily->GUIFont,FontSize->13,Bold],
SpanFromLeft},
{Style["dx",12],
InputField[Dynamic[dx],ImageSize->{30,25}],
Style["dy",12],
InputField[Dynamic[dy],ImageSize->{30,25}]},
{customInitialGridCheckbox,
SpanFromLeft},
{customInitialConditionsButton,
SpanFromLeft}},
Spacings-> {Automatic,{2->1,3->.75,4->0}},
Alignment->Left],
ImageSize->{150,125},
BaseStyle->GUIStyle]];

Dynamics control panel

timeField=InputField[Dynamic[time],ImageSize->{40,20}];

temperatureField=InputField[Dynamic[temperature],ImageSize->{40,20}];

orderBar=SetterBar[Dynamic[order],Range[2]];

calculateOrbitsControl=Row[{
Checkbox[Dynamic[calculateOrbitsFlag]],
Style["Orbits",FontFamily->GUIFont,FontSize->12]}," "];
calculateRestpointsControl=Row[{
Checkbox[Dynamic[calculateRestpointsFlag]],
Style["Rest points",FontFamily->GUIFont,FontSize->12]}," "];

dynamicsMenu=PopupMenu[
Dynamic[dynamics],
{"Replicator"->Style[
"Replicator Dynamics",
FontFamily->GUIFont,FontSize->12],
"MaynardSmith"->Style[
"Maynard Smith Dynamics",
FontFamily->GUIFont,FontSize->12],
"Entropic"->Style[
"Entropy-Adjusted Dynamics",
FontFamily->GUIFont,FontSize->12],
"ImitativeLogit"->Style[
"Imitative Logit dynamics",
FontFamily->GUIFont,FontSize->12],
"Smith"->Style[
"Smith Dynamics",
FontFamily->GUIFont,FontSize->12],
"BNN"->Style[
"Brown–von Neumann–Nash",
FontFamily->GUIFont,FontSize->12],
"Logit"->Style[
"Logit dynamics",
FontFamily->GUIFont,FontSize->12],
"Custom"->Style[
"Custom dynamics",
FontFamily->GUIFont,FontSize->12]},
ImageSize->{220,Automatic}];

inputDynamicsButton=Deploy[
Button[
Style["Input Dynamics",
FontFamily->GUIFont],
CreateDialog[
dynamics="Custom";
CustomField[x_,y_]:={xCustomField,yCustomField};
Grid[
{{"(Subscript[V, x]) ",
InputField[Dynamic[xCustomField]]},
{"(Subscript[V, y]) ",
InputField[Dynamic[yCustomField]]},
{DefaultButton["Set Dynamics",
DialogReturn[{xCustomField,yCustomField}]],
SpanFromLeft}}]];
CustomField[xx_,yy_]:={xCustomField,yCustomField}/.{x->xx,y->yy}]];

updateButton=Deploy[
DefaultButton[
Style["Update Graph",
FontFamily->GUIFont,Bold,14],
NotebookLocate["Update"];
FrontEndExecute[FrontEndToken["Evaluate"]];
NotebookLocate["Update"];
FrontEndExecute[FrontEndToken["OpenCloseGroup"]];
NotebookLocate["GameSeer"];
FrontEndExecute[FrontEndToken["Evaluate"]]]];

dynamicsPanel=Deploy[
Panel[
Grid[{
{Style["Dynamics Calculations",Bold],
SpanFromLeft},
{Style["Order   ",12],
orderBar,
dynamicsMenu,SpanFromLeft},
{Style["Temp. ",12],
temperatureField,
calculateRestpointsControl,
inputDynamicsButton},
{Style["Time  ",12],
timeField,
calculateOrbitsControl,
updateButton}},
Alignment->{Left,Baseline},
Spacings->{{2->0,3->2},{3->1/2,4->1/4}},
BaseStyle->GUIStyle],
ImageSize->{Automatic,125}]];

Dynamics display

infoPanel=
Panel[
Grid[
{{Dynamic[
Style["Equations of Motion ("<>dynamics<>" dynamics)",Bold]],
SpanFromLeft},
{(Subscript[V, x])[x,y]==xDisplayField//TraditionalForm},
{(Subscript[V, y])[x,y]==yDisplayField//TraditionalForm}},
Alignment->{Left,Top},
Spacings->{Automatic,1.5},
BaseStyle->GUIStyle],
ImageSize->{600,Automatic}];

Output control panel

boundaryControl=Row[{
Checkbox[Dynamic[boundaryFlag]],
Style["Boundary",FontFamily->GUIFont,FontSize->12]}," "];
latticeControl=Row[{
Checkbox[Dynamic[latticeFlag]],
Style["Initial points",FontFamily->GUIFont,FontSize->12]}," "];
labelsControl=Row[{
Checkbox[Dynamic[labelsFlag]],
Style["Game labels",FontFamily->GUIFont,FontSize->12]}," "];
gridControl=Row[{
Checkbox[Dynamic[gridFlag]],
Style["Gridlines",FontFamily->GUIFont,FontSize->12]}," "];
vectorsControl=Row[{
Checkbox[Dynamic[showVectorsFlag]],
Style["Vectors",FontFamily->GUIFont,FontSize->12]}," "];
orbitsControl=Row[{
Checkbox[Dynamic[showOrbitsFlag]],
Style["Orbits",FontFamily->GUIFont,FontSize->12]}," "];
equilibriumControl=Row[{
Checkbox[Dynamic[equilibriumFlag]],
Style["Nash Equilibria",FontFamily->GUIFont,FontSize->12]}," "];
restpointsControl=Row[{
Checkbox[Dynamic[showRestpointsFlag]],
Style["Rest points",FontFamily->GUIFont,FontSize->12]}," "];

saveDataButton=Deploy[
Button[
Style["Export data",
FontFamily->GUIFont],
NotebookLocate["ExportData"];
FrontEndExecute[FrontEndToken["Evaluate"]];
NotebookLocate["Export"];
FrontEndExecute[FrontEndToken["OpenCloseGroup"]];
NotebookLocate["GameSeer"];
FrontEndExecute[FrontEndToken["Evaluate"]],
ImageSize->{100,Automatic}]];

savePlotButton=Deploy[
Button[
Style["Export plot",
FontFamily->GUIFont],
NotebookLocate["ExportPlot"];
FrontEndExecute[FrontEndToken["Evaluate"]];
NotebookLocate["Export"];
FrontEndExecute[FrontEndToken["OpenCloseGroup"]];
NotebookLocate["GameSeer"];
FrontEndExecute[FrontEndToken["Evaluate"]],
ImageSize->{100,Automatic}]];

controlPanel=Deploy[
Panel[
Grid[{
{Style["Display and Output Options",Bold],
SpanFromLeft},
{boundaryControl,
gridControl,
labelsControl,
equilibriumControl,
saveDataButton},
{latticeControl,
restpointsControl,
vectorsControl,
orbitsControl,
savePlotButton}},
Spacings-> {2,{2->1}},
Alignment->Left,
BaseStyle->GUIStyle],
ImageSize->{600,Automatic}]];

Static Elements

Boundary

vertices=Tuples[{0,1},2];
edges={{1,2},{2,4},{4,3},{3,1}};

boundary=Graphics[
{boundaryColor,AbsoluteThickness[boundaryThickness],GraphicsComplex[vertices,Line[edges]]}];

Gridlines

xgrid=Graphics[Table[
Append[
gridStyle,
Line[{{x,0},{x,1}}]],
{x,xtick,1-xtick,xtick}]];
ygrid=Graphics[Table[
Append[
gridStyle,
Line[{{0,y},{1,y}}]],
{y,ytick,1-ytick,ytick}]];
grid={xgrid,ygrid};

Game Elements

Vertex labels

nodeStyle={PointSize[Medium],ColorData[1,1]};nodes=Graphics[Table[Append[nodeStyle,Point[point]],{point,vertices}]];

labels=Graphics[
Table[
Text[
Style["("
<>ToString[{point[[1]],1-point[[1]]}.game[[1]].{point[[2]],1-point[[2]]}//Rationalize,InputForm]<>
", "
<>ToString[{point[[1]],1-point[[1]]}.game[[2]].{point[[2]],1-point[[2]]}//Rationalize,InputForm]<>")",
FontSize->18,Bold],
{1/2,1/2}+.9(point-{1/2,1/2}),
Background->Opacity[.75,White]],
{point,vertices}]];

Nash Equilibria

eqSolutionField=FullSimplify[Rationalize[SmithField[game,{x,y}]],0≤x≤1&&0≤y≤1];

equilibriumData=Solve[
eqSolutionField[[1]]==0&&
eqSolutionField[[2]]==0&&
0≤x≤1&&
0≤y≤1,{x,y}]//Simplify;

equilibria={};
xFlag=False;
yFlag=False;
Clear[t];
tempEquilibriumData={0,0};
tempEquilibrium=Graphics[];
Do[
xFlag=False;
yFlag=False;
tempEquilibriumData=Evaluate[{x,y}]/.solution;
Set[xFlag,x===tempEquilibriumData[[1]]];
Set[yFlag,y===tempEquilibriumData[[2]]];
tempEquilibriumData=tempEquilibriumData/.Which[xFlag,x,yFlag,y]->t;
If[
xFlag~Or~yFlag,
tempEquilibrium=ParametricPlot[
tempEquilibriumData,{t,0,1},
Axes->False,
PlotStyle->{equilibriumColor,AbsoluteThickness[equilibriumThickness]},
PlotRange->{{-.025,1.025},{-0.025,1.025}}],
tempEquilibrium=Graphics[
{equilibriumColor,AbsolutePointSize[3equilibriumThickness],Point[tempEquilibriumData]}]];
equilibria=Append[equilibria,tempEquilibrium],
{solution,equilibriumData}];

Dynamics Elements

Initial points

standardLatticePoints=Flatten[Table[Rationalize[{x,y}],{x,0,1,dx},{y,0,1,dy}],1];

latticePoints=If[
customLatticeQ,
customLatticePoints,
standardLatticePoints];

lattice=Graphics[
Table[
Append[
latticePointStyle,
Point[point]],
{point,latticePoints}]];

Dynamics

Clear[xTemp,yTemp,xScoreTemp,yScoreTemp]

{tempSimplexField,
tempScoreFieldSimplexVariables,
tempScoreField}=
Rationalize[
Switch[
dynamics,
"Replicator",
{FullSimplify[ReplicatorField[game,{xTemp,yTemp}],0≤x≤1&&0≤y≤1],
FullSimplify[ReplicatorScoreField[game,{xTemp,yTemp}],0≤x≤1&&0≤y≤1],
FullSimplify[ReplicatorScoreField[game,Expit[{xScoreTemp,yScoreTemp}]],0≤x≤1&&0≤y≤1]},
"MaynardSmith",
{FullSimplify[MaynardSmithField[game,{xTemp,yTemp}],0≤x≤1&&0≤y≤1],
FullSimplify[MaynardSmithScoreField[game,{xTemp,yTemp}],0≤x≤1&&0≤y≤1],
FullSimplify[MaynardSmithScoreField[game,Expit[{xScoreTemp,yScoreTemp}]],0≤x≤1&&0≤y≤1]},
"Smith",
{FullSimplify[SmithField[game,{xTemp,yTemp}],0≤x≤1&&0≤y≤1],
FullSimplify[SmithScoreField[game,{xTemp,yTemp}],0≤x≤1&&0≤y≤1],
FullSimplify[SmithScoreField[game,Expit[{xScoreTemp,yScoreTemp}]],0≤x≤1&&0≤y≤1]},
"BNN",
{FullSimplify[BNNField[game,{xTemp,yTemp}],0≤x≤1&&0≤y≤1],
FullSimplify[BNNScoreField[game,{xTemp,yTemp}],0≤x≤1&&0≤y≤1],
FullSimplify[BNNScoreField[game,Expit[{xScoreTemp,yScoreTemp}]],0≤x≤1&&0≤y≤1]},
"Logit",
{FullSimplify[LogitField[game,{xTemp,yTemp},temperature],0≤x≤1&&0≤y≤1],
FullSimplify[LogitScoreField[game,{xTemp,yTemp},temperature],0≤x≤1&&0≤y≤1],
FullSimplify[LogitScoreField[game,Expit[{xScoreTemp,yScoreTemp},temperature]],0≤x≤1&&0≤y≤1]},
"ImitativeLogit",
{FullSimplify[ImitativeLogitField[game,{xTemp,yTemp},temperature],0≤x≤1&&0≤y≤1],
FullSimplify[ImitativeLogitScoreField[game,{xTemp,yTemp},temperature],0≤x≤1&&0≤y≤1],
FullSimplify[ImitativeLogitScoreField[game,Expit[{xScoreTemp,yScoreTemp},temperature]],0≤x≤1&&0≤y≤1]},
"Entropic",
{FullSimplify[EntropicField[game,{xTemp,yTemp},temperature],0≤x≤1&&0≤y≤1],
FullSimplify[EntropicScoreField[game,{xTemp,yTemp},temperature],0≤x≤1&&0≤y≤1],
FullSimplify[EntropicScoreField[game,Expit[{xScoreTemp,yScoreTemp}],temperature],0≤x≤1&&0≤y≤1]},
"Custom",
{FullSimplify[CustomField[xTemp,yTemp],0≤x≤1&&0≤y≤1],
FullSimplify[CustomScoreField[xTemp,yTemp],0≤x≤1&&0≤y≤1],
FullSimplify[CustomScoreField@@Expit[{xScoreTemp,yScoreTemp}],0≤x≤1&&0≤y≤1]}]];

SimplexField[x_,y_]:=tempSimplexField/.{xTemp->x,yTemp->y};
SimplexField[vec_]:=SimplexField[vec[[1]],vec[[2]]];

xField[x_,y_]:=tempSimplexField[[1]]/.{xTemp->x,yTemp->y};
xField[vec_]:=xField[vec[[1]],vec[[2]]];

yField[x_,y_]:=tempSimplexField[[2]]/.{xTemp->x,yTemp->y};
yField[vec_]:=yField[vec[[1]],vec[[2]]];

SimplexEvolution[x0_,y0_]:=Flatten[
NDSolve[
{x'[t]==xField[x[t],y[t]],
y'[t]==yField[x[t],y[t]],
x[0]==x0,
y[0]==y0},
{x,y},
{t,0,time}]];
SimplexEvolution[point_]:=SimplexEvolution[point[[1]],point[[2]]];

tempScoreFieldCases=Table[
Simplify[
tempScoreFieldSimplexVariables/.{xTemp->Expit[xScore],yTemp->Expit[yScore]}],
{xScore,{-∞,∞,xScoreTemp}},
{yScore,{-∞,∞,yScoreTemp}}];
ScoreField[xScore_,yScore_]:=Switch[
xScore,
-∞,
Switch[
yScore,
-∞,
tempScoreFieldCases[[1,1]]/.yScoreTemp->yScore,
∞,
tempScoreFieldCases[[1,2]]/.yScoreTemp->yScore,
_,
tempScoreFieldCases[[1,3]]/.yScoreTemp->yScore],
∞,
Switch[
yScore,
-∞,
tempScoreFieldCases[[2,1]]/.yScoreTemp->yScore,
∞,
tempScoreFieldCases[[2,2]]/.yScoreTemp->yScore,
_,
tempScoreFieldCases[[2,3]]/.yScoreTemp->yScore],
_,
Switch[
yScore,
-∞,
tempScoreFieldCases[[3,1]]/.xScoreTemp->xScore,
∞,
tempScoreFieldCases[[3,2]]/.xScoreTemp->xScore,
_,
tempScoreFieldCases[[3,3]]/.{xScoreTemp->xScore,yScoreTemp->yScore}]];
ScoreField[vec_]:=ScoreField@@vec;

Wx[vec_]:=ScoreField[vec][[1]];
Wy[vec_]:=ScoreField[vec][[2]];
Wx[xScore_,yScore_]:=Wx[{xScore,yScore}];
Wy[xScore_,yScore_]:=Wy[{xScore,yScore}];

ScoreEvolution[xScore0_,yScore0_]:=Switch[
order,
1,
(*First Order Dynamics*)
If[
xScore0≠-∞&&xScore0≠∞,
If[
yScore0≠-∞&&yScore0≠∞,
(*Both scores finite*)
Flatten[
NDSolve[
{xScore'[t]==Wx[xScore[t],yScore[t]],
yScore'[t]==Wy[xScore[t],yScore[t]],
xScore[0]==xScore0,
yScore[0]==yScore0},
{xScore,yScore},
{t,0,time}]],
(*xScore finite, yScore infinite*)
{Part[
NDSolve[
{xScore'[t]==Wx[xScore[t],yScore0],
xScore[0]==xScore0},
{xScore},
{t,0,time}],1,1],
yScore->Function[yScore0]}],
If[
yScore0≠-∞&&yScore0≠∞,
(*xScore infinite, yScore finite*)
{xScore->Function[xScore0],
Part[
NDSolve[
{yScore'[t]==Wy[xScore0,yScore[t]],
yScore[0]==yScore0},
{yScore},
{t,0,time}],1,1]},
(*Both scores infinite*)
{xScore->Function[xScore0],
yScore->Function[yScore0]}]],
2,
(*Second Order Dynamics*)
If[
xScore0≠-∞&&xScore0≠∞,
If[
yScore0≠-∞&&yScore0≠∞,
(*Both scores finite*)
Flatten[
NDSolve[
{xScore''[t]==Wx[xScore[t],yScore[t]],
yScore''[t]==Wy[xScore[t],yScore[t]],
xScore[0]==xScore0,
xScore'[0]==0,
yScore[0]==yScore0,
yScore'[0]==0},
{xScore,yScore},
{t,0,time}]],
(*xScore finite, yScore infinite*)
{Part[
NDSolve[
{xScore''[t]==Wx[xScore[t],yScore0],
xScore[0]==xScore0,
xScore'[0]==0},
{xScore},
{t,0,time}],1,1],
yScore->Function[yScore0]}],
If[
yScore0≠-∞&&yScore0≠∞,
(*xScore infinite, yScore finite*)
{xScore->Function[xScore0],
Part[
NDSolve[
{yScore''[t]==Wy[xScore0,yScore[t]],
yScore[0]==yScore0,
yScore'[0]==0},
{yScore},
{t,0,time}],1,1]},
(*Both scores infinite*)
{xScore->Function[xScore0],
yScore->Function[yScore0]}]]];
ScoreEvolution[point_]:=ScoreEvolution[point[[1]],point[[2]]];

Orbits

If[
calculateOrbitsFlag,
(*If asked to calculate orbits*)
solutionData=Switch[
ImitationQ[dynamics],
True,
Table[
Table[
Evaluate[Clip[{xScore[t],yScore[t]},{-plotclip,plotclip}]/.ScoreEvolution[point]],{t,0,time,time/resolution}],
{point,Logit[latticePoints]}],
False,
Table[
Table[
Evaluate[{x[t],y[t]}/.SimplexEvolution[point]],{t,0,time,time/resolution}],
{point,latticePoints}]];
orbitsData=Switch[
ImitationQ[dynamics],
True,
Chop[Expit[solutionData],plotchop],
False,
solutionData];
orbits=Graphics[
Table[
Append[orbitStyle,Line[orbitsData[[iPoint]]]],
{iPoint,Length[latticePoints]}]],
(*If not asked to calculate orbits*)
orbits={}];

Rest Points

If[
calculateRestpointsFlag,
(*If asked to calculate restpoints*)
restSolutionField=If[
OnlyInteriorRestpointsQ[dynamics],
FullSimplify[Rationalize[SimplexField[x,y]],0<x<1&&0<y<1],
FullSimplify[Rationalize[SimplexField[x,y]],0≤x≤1&&0≤y≤1]];
restpointsData=If[
OnlyInteriorRestpointsQ[dynamics],
NSolve[
restSolutionField[[1]]==0&&restSolutionField[[2]]==0&&0<x<1&&0<y<1,
{x,y},Reals],
NSolve[
restSolutionField[[1]]==0&&restSolutionField[[2]]==0&&0≤x≤1&&0≤y≤1,
{x,y},Reals]];
restpoints={};
xFlag=False;
yFlag=False;
Clear[t];
tempRestpointsData={0,0};
tempRestpoint=Graphics[];
Do[
xFlag=False;
yFlag=False;
tempRestpointsData=Evaluate[{x,y}]/.solution;
Set[xFlag,x===tempRestpointsData[[1]]];
Set[yFlag,y===tempRestpointsData[[2]]];
tempRestpointsData=tempRestpointsData/.Which[xFlag,x,yFlag,y]->t;
If[
xFlag~Or~yFlag,
tempRestpoint=ParametricPlot[
tempRestpointsData,{t,0,1},
Axes->False,
PlotStyle->{restColor,AbsoluteThickness[2]},
PlotRange->{{-.025,1.025},{-0.025,1.025}}],
tempRestpoint=Graphics[
{LightBlue,EdgeForm[{restColor,Thick}],
Disk[tempRestpointsData,.006]}]];
restpoints=Append[restpoints,tempRestpoint],
{solution,restpointsData}],
(*If not asked to calculate restpoints*)
restpoints={}];

Vectors

vectorTip=Graphics[
{vectorColor,
Polygon[1/9{{0,1},{2,1},{12,0},{2,-1},{0,-1}}]}];
vectorShaftLength=Switch[order,1,Max[vectorLength,2],2,2];
vectorStyle={Arrowheads[{{.04,Automatic,vectorTip}}],vectorColor,AbsoluteThickness[vectorThickness]};

If[
calculateOrbitsFlag,
(*If asked to calculate orbits*)
vectors=Graphics[
Table[vectorStyle~Append~Arrow[orbit[[Range[1,vectorShaftLength]]]],
{orbit,orbitsData}]],
(*If not asked to calculate orbits*)
vectors={}];

Graph Elements

graph=Dynamic[
Show[
If[
Nor[
boundaryFlag,
labelsFlag,
gridFlag,
latticeFlag,
equilibriumFlag,
showRestpointsFlag,
showVectorsFlag,
showOrbitsFlag],emptyGraph,{}],
If[boundaryFlag,boundary,{}],
If[gridFlag,grid,{}],
If[showOrbitsFlag,orbits,{}],
If[latticeFlag,lattice,{}],
If[showVectorsFlag,vectors,{}],
If[labelsFlag,labels,{}],
If[showRestpointsFlag,restpoints,{}],
If[equilibriumFlag,equilibria,{}],
Background->White,
ImageSize->Full,
Frame->True,
FrameLabel->frameLabel,
BaseStyle->{FontFamily->"Times",FontSize->14},
PlotRange->{{-.02,1.02},{-.02,1.02}}]];

Output Elements

graphFlags={boundaryFlag,gridFlag,showOrbitsFlag,latticeFlag,showVectorsFlag,labelsFlag,showRestpointsFlag,equilibriumFlag};
graphObjects={boundary,grid,orbits,lattice,vectors,labels,restpoints,equilibria};

graphData={};
Do[
If[
graphFlags[[iFlag]],
graphData=Append[graphData,graphObjects[[iFlag]]]],
{iFlag,Length[graphFlags]}];

Export Data

dataFileName=FileNameJoin[
{NotebookDirectory[],
"GameSeerData("<>
dynamics<>
"-"<>
DateString[{"Month","Day","Hour","Minute"}]<>
").dat"}];
Save[
dataFileName,
{game,
equilibriumData,
dynamics,
SimplexField,
ScoreField,
restpointsData,
latticePoints,
orbitsData,
graphData}];

Export Plot

outputGraph=Show[
graphData,
ImageSize->600,
Background->White,
Frame->True,
FrameLabel->frameLabel,
BaseStyle->{FontFamily->"Times",FontSize->14},
PlotRange->{{-.02,1.02},{-.02,1.02}}];
plotFileName=FileNameJoin[
{NotebookDirectory[],
"GameSeerPlot("<>
dynamics<>
"-"<>
DateString[{"Month","Day","Hour","Minute"}]<>
").pdf"}];Export[plotFileName,outputGraph];