Mathematica Projects by High School Students

Ryan Chuang, Samantha Patterson, Jenny Tan, and Jeffrey Tsao

Torrey Pines High School

Torrey Pines' Advanced Topics in Mathematics II Class

A project research class using Mathematica.

Our Experience as Students

Used Mathematica version 4.1 in calculus courses last year

Started using 6 this fall

So Far...

All of the students in our class have finished a Manipulate project and a few have started using Dynamic.

Some of our projects are already on the Demonstrations site.

Long Term ...

Community service and benefits: activities and teaching tools for in-class use (grades 7-12).
	Algebra program
	Special Education
	"Demonstrations" of any mathematical situation to help students visualize

Student Manipulate Examples

Person Walking from Spotlight

Practice with Graphics primitives

Manipulate[
Grid[{{
Column[{
"Conditions:",
"  -Spotlight is 12 metres away ",
"     from the wall",
"  -The person is walking at 1.6",
"     metres per second",
"  -The person is 2 metres tall",
"",
		Row[{"Metres away from wall = ",If[a≠12,12-a,"SPLAT!!"]}],
Row[{"Shadow Height = ",24/a}],
Row[{"Shadow Decrease Rate = ",-24/(a^2)*1.6}]}
],
Deploy[Show[{
Plot[2*x/a,{x,0,0.5},Axes->False,PlotRange->{{0,13},{-1,20}}],
Graphics[{
{Blend[{Blue,Black},0.2],Polygon[{{0,.8},{0,20},{12,24},{.5,1}}]},
{Yellow,Opacity[0.8],Polygon[{{0,0},{12,24},{12,24/a}}]},
{Yellow,Opacity[0.8],Polygon[{{0,0},{a,2},{a+0.2,0}}]},
{Blend[{White,Gray},0.5],Polygon[{{12,0},{12,20},{13,20},{13,0}}]},
{Opacity[0.4],Blend[{Yellow,Black},0.5],Polygon[{{a+0.2,0},{a,2},{12,24/a},{12,0}}]},
{Gray,Polygon[{{0,0},{0.5,0},{.5,1},{0,.8}}]},
{White,Thickness[0.01],Line[{{.5,0},{.5,1}}]},
{Red,Thickness[0.015],Line[{{a,1},{a,2}}]},
{Red,PointSize[0.03],Point[{a+0.05,2}]},
{Red,Thickness[0.01],Line[{{a,1},{a-0.25*Cos[2*a],0}}]},
{Red,Thickness[0.01],Line[{{a,1},{a+0.25*Cos[2*a],0}}]},
{Red,Thickness[0.007],Line[{{a,1.7},{a-0.2*Cos[2*a],1}}]},
{Red,Thickness[0.007],Line[{{a,1.7},{a+0.2*Cos[2*a],1}}]},
Line[{{12,0},{12,20}}],
{Thickness[0.005],Line[{{a+0.2,-0.1},{12,-0.1}}]},
{Thickness[0.009],Line[{{12,0},{12,23/a}}]},
{Thickness[.001],Line[{{0,0},{12,0}}]},
{White,Disk[{3,17},2]},
{Blend[{Blue,Black},0.2],Disk[{4,17},2.5]},
{White,Disk[{5,15},0.1]},
{White,Disk[{6,18},0.1]},
{White,Disk[{3,17},0.1]},
{White,Disk[{2,9},0.1]},
{White,Disk[{1,5},0.1]},
{White,Disk[{4,10},0.1]},
{White,Disk[{3,7},0.1]},
{White,Disk[{2,11},0.1]},
{White,Disk[{1,13},0.1]},
{White,Disk[{4,13},0.1]},
{White,Disk[{7,16},0.1]}
}]
},ImageSize->{350,400},AspectRatio->Automatic]]
}},ItemSize->{{16,24},Automatic},Alignment->{Left}],
{{a,4,"distance from spotlight"},1,12},AutorunSequencing->Automatic, ControllerLinking->True]

Related Rates: Inflating Balloon

Two controls that affect each other

Manipulate[
Column[
{Graphics3D[{Green,Opacity[0.45],Specularity[White,15],Sphere[{0,0,0},(.75 v/Pi)^(1/3)]},PlotRange->3,Boxed->False,ImageSize->{500,300}], Row[{"dr/dt = ",If[Or[r==0.00001,v==0.00001],∞,5/(Pi(r^2))]}]}],
{{r,1,"Radius"},Manipulator[Dynamic[r,(r=#;v=(4 Pi #^3)/3)&], {0.00001,3}, Appearance->"Open"]&},
{{v,4.18879, "Volume"},Manipulator[Dynamic[v,(v=#;r=(((.75#)/Pi)^(1/3)))&],{0.00001,36Pi},Appearance->"Open"]&},ControllerLinking->True]

A Snowball's Rate of Change

Some have also expanded their illustration of the problem situation by adding graphs that change according to the manipulate slider.

Manipulate[
Deploy[
Grid[{
{Graphics3D[Sphere[{0,0,0},400Pi-t],PlotRange->400Pi,Boxed->False,PlotLabel->Style["snowball",18,Bold],ImageSize->100],Column[{sty[{"diameter",((-t+400Pi)/Pi)^0.5,Black}],sty[{"rate of diameter",(((-t+400Pi)/Pi)^0.5)/(2*(-t+400Pi)),Black}],Labeled[Show[ParametricPlot[{-t+400Pi,((-t+400Pi)/Pi)^0.5},{t,0,400Pi},AspectRatio->1/3],Graphics[{Red,Arrow[{{-t+400Pi,((-t+400Pi)/Pi)^0.5},{-t+400Pi,0}}]},PlotRange->400Pi],Graphics[{Red,Arrow[{{-t+400Pi,((-t+400Pi)/Pi)^0.5},{0,((-t+400Pi)/Pi)^0.5}}]}],ImageSize->175],
Style["Diameter vs. Surface Area",16,Bold,FontFamily->"Times"],Top]}
]},
{Show[
Plot[-t+400Pi,{t,0,400Pi},PlotRange->{0,400Pi}],
Graphics[{Red,Line[{{t,-t+400Pi},{t,0}}]},PlotRange->400Pi],
Graphics[{Red,Arrow[{{t,-t+400Pi},{0,-t+400Pi}}]}],PlotLabel->Style["Surface Area",18,Bold,FontFamily->"Times"],ImageSize->175],
Show[
Plot[((-t+400Pi)/Pi)^0.5,{t,0,400Pi}],
Graphics[{Red,Line[{{t,((-t+400Pi)/Pi)^0.5},{t,0}}]},PlotRange->400Pi],Graphics[{Red,Arrow[{{t,((-t+400Pi)/Pi)^0.5},{0,((-t+400Pi)/Pi)^0.5}}]}],PlotLabel->Style["Diameter",18,Bold,FontFamily->"Times"],ImageSize->175]},{Show[Plot[-1,{t,0,400Pi},PlotRange->{-2,2}],Graphics[{Green,Arrow[{{t,-1},{t,0}}]}],PlotLabel->Style["Rate of Surface Area",18,Bold,FontFamily->"Times"],ImageSize->175],
Show[Plot[(((-t+400Pi)/Pi)^0.5)/(2*(-t+400Pi)),{t,0,400Pi}],Graphics[{Green,Arrow[{{t,(((-t+400Pi)/Pi)^0.5)/(2*(-t+400Pi))},{t,-.1}}]},PlotRange->{0,400Pi}],
Graphics[{Green,Arrow[{{t,(((-t+400Pi)/Pi)^0.5)/(2*(-t+400Pi))},{0,(((-t+400Pi)/Pi)^0.5)/(2*(-t+400Pi))}}]}],PlotLabel->Style["Rate of Diameter",18,Bold,FontFamily->"Times"],ImageSize->175]}}]],{t,0,400*Pi-0.00001},ControllerLinking->True,AutorunSequencing->Automatic,Initialization:>{sty[list_]:=Style[StringJoin[ToString[list[[1]]]," = ",ToString[list[[2]]]],11,Bold,list[[3]],FontFamily->"Arial"]},
AutorunSequencing->Automatic, ControllerLinking->True]

Minimization Problem (Surface Area of a Can)

Two communicating controls and graphs

Manipulate[
Deploy[Row[{
Graphics3D[{Opacity[0.5],Cylinder[{{0,0,0},{0,0,h}},r]},PlotRange->{{-Sqrt[v/(Pi)],Sqrt[v/(Pi)]},{-Sqrt[v/(Pi)],Sqrt[v/(Pi)]},{0,32}},ImageSize->250,Boxed->False],

Column[{
sty[{"Surface Area",2 Pi r^2+2 Pi r h,RGBColor[0.6,0,0.6`]}],sty[{"height",h,RGBColor[0,.6,.3]}],sty[{"radius",r,Hue[.1]}],

Show[Plot[2 Pi(v/Pi/h)+2(Sqrt[v Pi h]),{h,0,30},PlotRange->{{0,30},{0,2000}},ImageSize->200,AxesLabel->{Style["h",RGBColor[0,.6,.3],11,Bold,FontFamily->"Arial"],Style["Surface Area",RGBColor[0.6,0,0.6`],11,Bold,FontFamily->"Arial"]},GridLines->{None,Automatic}],Graphics[{Red,Arrow[{{h,0},{h,2 Pi(v/Pi/h)+2(Sqrt[v Pi h])}}]}]],

Show[Plot[2 Pi r^2+2(v/r),{r,0,Sqrt[v/(Pi)]},PlotRange->{{0,Sqrt[v/(Pi)]},{0,2000}},ImageSize->200,AxesLabel->{Style["r",Hue[.1],11,Bold,FontFamily->"Arial"],Style["Surface Area",RGBColor[0.6,0,0.6`],11,Bold,FontFamily->"Arial"]},GridLines->{None,Automatic}],
Graphics[{Red,Arrow[{{r,0},{r,2 Pi r^2+2(v/r)}}]},PlotRange->{{0,Sqrt[v/(Pi)]},{0,3}}]]
},Dividers->{None,{False,False,False,True,False}}]
}]],

{{v,1000,Style[volume,11,Bold,Blue,FontFamily->"Arial"]},{500,1000,2000,1024 Pi},ControlType->PopupMenu},

{{h,25,Style[height,11,RGBColor[0,.6,.3],Bold,FontFamily->"Arial"]},
Manipulator[Dynamic[h,(h=#;r=Sqrt[v/(Pi h)])&],{1,30}]&},

{{r,N[Sqrt[40/Pi]],Style[radius,Hue[.1],11,Bold,FontFamily->"Arial"]},Manipulator[Dynamic[r,(r=#;h=v/(Pi r^2))&],{Sqrt[v/(30 Pi)],Sqrt[v/(Pi)]}]&},

Initialization:> {sty[list_]:=Style[StringJoin[ToString[list[[1]]]," = ",ToString[list[[2]]]],11,Bold,list[[3]],FontFamily->"Arial"]},AutorunSequencing->Automatic, ControllerLinking->True
]

Music Box Model

{{1,0,0,0,0,0,1},{0,1,0,0,1,0,0},{0,0,0,0,1,1,0},{0,0,1,1,0,0,0},{0,0,0,1,1,0,0},{0,1,0,0,0,1,0}}

wid=7; leng=6;
Row[{
Column[Table[CheckboxBar[Dynamic[varlist],Table[var[i,j]->"",{j,1,wid}]],{i,1,leng}]],
"  ",
Dynamic[valuelist=Table[If[MemberQ[varlist,var[i,j]],1,0],{i,1,leng},{j,1,wid}]],"  "
}]

Clear[valuelist]

s=46;
Dynamic[
EmitSound[Sound[
Table[
If[MemberQ[valuelist[[i]],1],
If[valuelist[[i,j]]==1,
Switch[j,
1,SoundNote["A4",{0,1},s],
2,SoundNote["E",{0,1},s],
3,SoundNote["G",{0,1},s],
4,SoundNote["A",{0,1},s],
5,SoundNote["B",{0,1},s],
6,SoundNote["D6",{0,1},s],
7,SoundNote["E6",{0,1},s]
],{}],{SoundNote["C7",{0,1/wid},"SoundVolume"->0]}],{i,1,leng},{j,1,wid}],Scaled[60/164]]]
]

Manipulate[
Dynamic[Graphics3D[{
{Darker[Gray,0.64],Specularity[Blue,80],Cylinder[RotationTransform[-theta,{1,0,0}][{{0,0,0},{wid+1,0,0}}],3]},
{Darker[Gray,0.2],Polygon[{{0,3.2,0},{0,6,0},{wid+1,6,0},{wid+1,3.2,0}}]},
Table[If[EvenQ[j],{Line[{{j-0.5,3.2,0},{j-0.5,6,0}}],Thickness[2],Darker[Gray,0.3]},{Line[{{j-0.5,3.2,0},{j-0.5,6,0}}],Thickness[0]}],{j,1,wid+1}],Table[If[valuelist[[i,j]]==1,{Darker[Gray,0.3],EdgeForm[],Specularity[White,20],Cylinder[RotationTransform[-theta,{1,0,0}][{{j,3Cos[2Pi/leng (i-1)],3Sin[2Pi/leng (i-1)]},{j,2.5Cos[2Pi/leng (i-1)],2.5Sin[2Pi/leng (i-1)]}+{0,Cos[2Pi/leng (i-1)],Sin[2Pi/leng (i-1)]}}],0.1]},{}],{i,1,leng},{j,1,wid}]
},PlotRange-> wid+1,Boxed->False(*,Lighting->{{"Point",White,{1,8,1}}}*)
]],{theta,0,2Pi}
]

League Table Generator

startsession[];

dynmod[]:=DynamicModule[{masterlist={}},
Column[{
Grid[{
{},
{Row[{"Results (preserved by DynamicModule)."}],SpanFromLeft},{Row[{InputField[Dynamic[masterlist],Enabled->False,FieldSize->{30,{5,5}}]}],SpanFromLeft},
{Row[{Button["Save Results",savelist[list_]:=NotebookWrite[NotebookCreate[],ToString[HoldForm[savedlist=InputForm[list]]]];savelist[masterlist],ImageSize->110],Button["Clear Results",masterlist={};Clear[Home,Away,Scr1,Scr2],ImageSize->110],Button["Update Table",h[];Map[f,masterlist],ImageSize->110],
Button["Clear Table",h[];rank[],ImageSize->110]
}],SpanFromLeft},
{},
{"Update results.",SpanFromLeft},
{Row[{InputField[Dynamic[Home[Length[masterlist]+1]]],"  ",Button["Enter"],"    ",InputField[Dynamic[Scr1[Length[masterlist]+1]],FieldSize->{4,{1,1}}],"  ",Button["Enter"]}],SpanFromLeft},
{Row[{InputField[Dynamic[Away[Length[masterlist]+1]]],"  ",Button["Enter"],"    ",InputField[Dynamic[Scr2[Length[masterlist]+1]],FieldSize->{4,{1,1}}],"  ",Button["Enter"]}],SpanFromLeft},
{Row[{Button["Add to Results",masterlist=Append[masterlist,
{Home[Length[masterlist]+1],Away[Length[masterlist]+1],
Scr1[Length[masterlist]+1],Scr2[Length[masterlist]+1]}],ImageSize->110],Button["Undo",masterlist=Drop[masterlist,-1],ImageSize->110]
}],SpanFromLeft},
{},
{"Import results previously saved as a list.",SpanFromLeft},
{Row[{
InputField[Dynamic[resultlist],FieldSize->{20,{1,1}}],"  ",Button["Import",masterlist=Join[masterlist,resultlist]],"  ",Button["Clear Input",Clear[resultlist]]
}],SpanFromLeft},
{},
{"Edit table directly (cannot be saved).",SpanFromLeft},
{Row[{InputField[Dynamic[Home[Length[masterlist]+1]]],"  ",Button["Enter"],"    ",InputField[Dynamic[Scr1[Length[masterlist]+1]],FieldSize->{4,{1,1}}],"  ",Button["Enter"]}],SpanFromLeft},
{Row[{InputField[Dynamic[Away[Length[masterlist]+1]]],"  ",Button["Enter"],"    ",InputField[Dynamic[Scr2[Length[masterlist]+1]],FieldSize->{4,{1,1}}],"  ",Button["Enter"]}],SpanFromLeft},
{Row[{Button["Add to Table",Map[f,{{Home[Length[masterlist]+1],Away[Length[masterlist]+1],
Scr1[Length[masterlist]+1],Scr2[Length[masterlist]+1]}}],ImageSize->110],Button["Remove from Table",Map[g,{{Home[Length[masterlist]+1],Away[Length[masterlist]+1],
Scr1[Length[masterlist]+1],Scr2[Length[masterlist]+1]}}],ImageSize->110]
}],SpanFromLeft},
{}
}]
}]
];

TabView[{"Enter Results"->dynmod[],"Premiership"->Dynamic[chart[Premiership]],"Serie A"->Dynamic[chart[SerieA]],"La Liga"->Dynamic[chart[LaLiga]]}]

HomePlayed[x_]:=0;HomeWins[x_]:=0;HomeDraws[x_]:=0;
HomeLosses[x_]:=0;HomeGoals[x_]:=0;HomeAllowed[x_]:=0;
AwayPlayed[x_]:=0;AwayWins[x_]:=0;AwayDraws[x_]:=0;AwayLosses[x_]:=0;AwayGoals[x_]:=0;AwayAllowed[x_]:=0;HomeCleanSheets[x_]:=0;AwayCleanSheets[x_]:=0;

Penalty[x_]:=0;
Penalty[ACMilan]=8;Penalty[Lazio]=11;Penalty[Reggina]=15;Penalty[Fiorentina]=19;

Played[x_]:=HomePlayed[x]+AwayPlayed[x];
Wins[x_]:=HomeWins[x]+AwayWins[x];
Draws[x_]:=HomeDraws[x]+AwayDraws[x];
Losses[x_]:=HomeLosses[x]+AwayLosses[x];
Goals[x_]:=HomeGoals[x]+AwayGoals[x];
Allowed[x_]:=HomeAllowed[x]+AwayAllowed[x];
CleanSheets[x_]:=HomeCleanSheets[x]+AwayCleanSheets[x];

Differential[x_]:=Goals[x]-Allowed[x];

HomePoints[x_]:=3*HomeWins[x]+HomeDraws[x];
AwayPoints[x_]:=3*AwayWins[x]+AwayDraws[x];
Points[x_]:=HomePoints[x]+AwayPoints[x]-Penalty[x];

Head2Head[x_,y_]:=0;
HeadDraws[x_,y_]:=0;
HeadDrawsTotal[x_,y_]:=HeadDraws[x,y]+HeadDraws[y,x];
HeadGoals[x_,y_]:=0;

list[Premiership]=Sort[{Arsenal,AstonVilla,Blackburn,Bolton,Charlton,Chelsea,Everton,Fulham,Liverpool,ManchesterCity,ManchesterUnited,Middlesbrough,Newcastle,Portsmouth,Reading,Sheffield,Tottenham,Watford,WestHam,Wigan},OrderedQ[{#1,#2}]&];

list[SerieA]=Sort[{ACMilan,Ascoli,ASRoma,Atalanta,Cagliari,Catania,ChievoVerona,Empoli,Fiorentina,InterMilan,Lazio,Livorno,Messina,Palermo,Parma,Reggina,Sampdoria,Siena,Torino,Udinese},OrderedQ[{#1,#2}]&];

list[LaLiga]=Sort[{Valencia,Barcelona,RealMadrid,RealBetis,Sevilla,AtleticoMadrid,RecreativoHuelva,DeportivoCoruna,Zaragoza,Getafe,Osasuna,Villareal,Levante,Mallorca,CeltaVigo,Espanyol,GimnasticdeTarrago,RacingSantander,AtleticoBilbao,RealSociedad},OrderedQ[{#1,#2}]&];

Name[x_]:=x;
Name[ACMilan]="AC Milan";Name[ASRoma]="AS Roma";Name[ChievoVerona]="Chievo Verona";Name[InterMilan]="Inter Milan";
Name[AstonVilla]="Aston Villa";Name[ManchesterCity]="Manchester City";Name[ManchesterUnited]="Manchester United";Name[WestHam]="West Ham";
Name[RealMadrid]="Real Madrid";Name[RealBetis]="Real Betis";
Name[CeltaVigo]="Celta Vigo";Name[AtleticoMadrid]="Atletico Madrid";Name[RecreativoHuelva]="Recreativo Huelva";Name[DeportivoCoruna]="Deportivo Coruna";Name[GimnasticdeTarrago]="Gimnastic de Tarrago";Name[RacingSantander]="Racing Santander";Name[AtleticoBilbao]="Atletico Bilbao";Name[RealSociedad]="Real Sociedad";

Arse=Arsenal;Manutd=ManchesterUnited;Pool=Liverpool;Spurs=Tottenham;Boro=Middlesbrough;Mancity=ManchesterCity;Villa=AstonVilla;Milan=ACMilan;Inter=InterMilan;Roma=ASRoma;WerderCL=WerderBremenCL;ArseCL=ArsenalCL;BarcaCL=BarcelonaCL;LevskiCL=LevskiSofiaCL;BayernCL=BayernMunichCL;SportingCL=SportingLisbonCL;InterCL=InterMilanCL;
PoolCL=LiverpoolCL;PSVCL=PSVEindhovenCL;RomaCL=ASRomaCL;ManutdCL=ManchesterUnitedCL;CopenhagenCL=FCCopenhagenCL;MilanCL=ACMilanCL;

Name[team]="Team";Played[team]="GP   ";Wins[team]="W    ";Draws[team]="D    ";Losses[team]="L    ";Goals[team]="GS   ";Allowed[team]="GA   ";Points[team]="Pts. ";Differential[team]="Diff.";

Name[blank]=" ";Played[blank]=" ";Wins[blank]=" ";Draws[blank]=" ";Losses[blank]=" ";Goals[blank]=" ";Allowed[blank]=" ";Points[blank]=" ";Differential[blank]=" ";

Name[dash]="-";Played[dash]="-";Wins[dash]="-";Draws[dash]="-";Losses[dash]="-";Goals[dash]="-";Allowed[dash]="-";Points[dash]="-";Differential[dash]="-";

rank[]:=
(*Module[{x},
{x1[league],x2[league],x3[league],x4[league],x5[league],x6[league],x7[league],x8[league],x9[league],x10[league],x11[league],x12[league],x13[league],x14[league],x15[league],x16[league],x17[league],x18[league],x19[league],x20[league]}=
Sort[Sort[Sort[Sort[list[league],Goals[#1]<Goals[#2]&],Differential[#1]>Differential[#2]&],Played[#1]>Played[#2]&],Points[#1]>Points[#2]&];
];*)
Module[{x},
rank[Premiership];
rank[SerieA];
rank[LaLiga];
];

rank[league_]:=
Module[{x},
{x1[league],x2[league],x3[league],x4[league],x5[league],x6[league],x7[league],x8[league],x9[league],x10[league],x11[league],x12[league],x13[league],x14[league],x15[league],x16[league],x17[league],x18[league],x19[league],x20[league]}=
Sort[Sort[Sort[Sort[list[league],Goals[#1]<Goals[#2]&],Differential[#1]>Differential[#2]&],Played[#1]>Played[#2]&],Points[#1]>Points[#2]&];
];

record[]:=
Module[{x},
Which[Team1Score>Team2Score,HomeWins[Team1]+=1,Team1Score==Team2Score,HomeDraws[Team1]+=1,Team1Score<Team2Score,HomeLosses[Team1]+=1];
Which[Team1Score>Team2Score,AwayLosses[Team2]+=1,Team1Score==Team2Score,AwayDraws[Team2]+=1,Team1Score<Team2Score,AwayWins[Team2]+=1];
Which[Team1Score>Team2Score,Head2Head[Team1,Team2]+=1,Team1Score==Team2Score,HeadDraws[Team1,Team2]+=1,Team1Score<Team2Score,Head2Head[Team2,Team1]+=1];
Which[Team1Score==0,AwayCleanSheets[Team2]+=1,Team2Score==0,HomeCleanSheets[Team1]+=1];
HomeGoals[Team1]+=Team1Score;AwayGoals[Team2]+=Team2Score;HomeAllowed[Team1]+=Team2Score; AwayAllowed[Team2]+=Team1Score;
HeadGoals[Team1,Team2]+=Team1Score;HeadGoals[Team2,Team1]+=Team2Score;
HomePlayed[Team1]+=1;AwayPlayed[Team2]+=1;
];

erase[]:=
Module[{x},
Which[Team1Score>Team2Score,HomeWins[Team1]+=-1,Team1Score==Team2Score,HomeDraws[Team1]+=-1,Team1Score<Team2Score,HomeLosses[Team1]+=-1];
Which[Team1Score>Team2Score,AwayLosses[Team2]+=-1,Team1Score==Team2Score,AwayDraws[Team2]+=-1,Team1Score<Team2Score,AwayWins[Team2]+=-1];
Which[Team1Score>Team2Score,Head2Head[Team1,Team2]+=-1,Team1Score==Team2Score,HeadDraws[Team1,Team2]+=-1,Team1Score<Team2Score,Head2Head[Team2,Team1]+=-1];
Which[Team1Score==0,AwayCleanSheets[Team2]+=-1,Team2Score==0,HomeCleanSheets[Team1]+=-1];
HomeGoals[Team1]+=-Team1Score;AwayGoals[Team2]+=-Team2Score;HomeAllowed[Team1]+=-Team2Score;AwayAllowed[Team2]+=-Team1Score;
HeadGoals[Team1,Team2]+=-Team1Score;HeadGoals[Team2,Team1]+=-Team2Score;
HomePlayed[Team1]+=-1;AwayPlayed[Team2]+=-1;
];

f[{Home_,Away_,HomeScore_,AwayScore_}]:=
Module[{x},
Team1=Home;
Team2=Away;
Team1Score=HomeScore;
Team2Score=AwayScore;
record[];
rank[];
];

g[{Home_,Away_,HomeScore_,AwayScore_}]:=
Module[{x},
Team1=Home;
Team2=Away;
Team1Score=HomeScore;
Team2Score=AwayScore;
erase[];
rank[];
];

h[]:=
Module[{x},
Clear[HomePlayed,HomeWins,HomeDraws,HomeLosses,HomeGoals,HomeAllowed,AwayPlayed,AwayWins,AwayDraws,AwayLosses,AwayGoals,AwayAllowed,HomeCleanSheets,AwayCleanSheets];
HomePlayed[x_]:=0;HomeWins[x_]:=0;HomeDraws[x_]:=0;
HomeLosses[x_]:=0;HomeGoals[x_]:=0;HomeAllowed[x_]:=0;
AwayPlayed[x_]:=0;AwayWins[x_]:=0;AwayDraws[x_]:=0;AwayLosses[x_]:=0;AwayGoals[x_]:=0;AwayAllowed[x_]:=0;HomeCleanSheets[x_]:=0;AwayCleanSheets[x_]:=0;
];

Compare[Team1_,Team2_]:=
Column[{
If[Head2Head[Team1,Team2]==0&&HeadDraws[Team1,Team2]==0&&Head2Head[Team2,Team1]==0,"No head-to-head record.",
Column[{
"Head-to-head record:",
Row[{
Dynamic[Head2Head[Team1,Team2]],If[Head2Head[Team1,Team2]==1," win "," wins "],Name[Team1],", ",Dynamic[HeadDrawsTotal[Team1,Team2]],If[HeadDrawsTotal[Team1,Team2]==1," draw, "," draws, "],Dynamic[Head2Head[Team2,Team1]],If[Head2Head[Team2,Team1]==1," win "," wins "],Name[Team2]
}],
Row[{
Dynamic[HeadGoals[Team1,Team2]],If[HeadGoals[Team1,Team2]==1," goal "," goals "],Name[Team1],", ",Dynamic[HeadGoals[Team2,Team1]],If[HeadGoals[Team2,Team1]==1," goal "," goals "],Name[Team2]
}]
}]
],
"",
Row[{"League statistics:"}],
Row[{
Dynamic[Points[Team1]],If[Points[Team1]==1," point "," points "],Name[Team1],", ",Dynamic[Points[Team2]],If[Points[Team2]==1," point "," points "],Name[Team2]
}]
}];

Spaces[x_]:="";
Spaces[Premiership]="   ";
Spaces[SerieA]="       ";
Spaces[LaLiga]="";

rank[];

chart[league_]:=
Column[{
Row[{
DynamicModule[{fcn=Name},
Column[{
Dynamic[fcn[team]],Dynamic[fcn[x1[league]]],Dynamic[fcn[x2[league]]],Dynamic[fcn[x3[league]]],Dynamic[fcn[x4[league]]],Dynamic[fcn[x5[league]]],Dynamic[fcn[x6[league]]],Dynamic[fcn[x7[league]]],Dynamic[fcn[x8[league]]],Dynamic[fcn[x9[league]]],Dynamic[fcn[x10[league]]],Dynamic[fcn[x11[league]]],Dynamic[fcn[x12[league]]],Dynamic[fcn[x13[league]]],Dynamic[fcn[x14[league]]],Dynamic[fcn[x15[league]]],Dynamic[fcn[x16[league]]],Dynamic[fcn[x17[league]]],Dynamic[fcn[x18[league]]],Dynamic[fcn[x19[league]]],Dynamic[fcn[x20[league]]]
}]
],
Dynamic[Spaces[league]],
DynamicModule[{fcn=Played},
Column[{
Dynamic[fcn[team]],Dynamic[fcn[x1[league]]],Dynamic[fcn[x2[league]]],Dynamic[fcn[x3[league]]],Dynamic[fcn[x4[league]]],Dynamic[fcn[x5[league]]],Dynamic[fcn[x6[league]]],Dynamic[fcn[x7[league]]],Dynamic[fcn[x8[league]]],Dynamic[fcn[x9[league]]],Dynamic[fcn[x10[league]]],Dynamic[fcn[x11[league]]],Dynamic[fcn[x12[league]]],Dynamic[fcn[x13[league]]],Dynamic[fcn[x14[league]]],Dynamic[fcn[x15[league]]],Dynamic[fcn[x16[league]]],Dynamic[fcn[x17[league]]],Dynamic[fcn[x18[league]]],Dynamic[fcn[x19[league]]],Dynamic[fcn[x20[league]]]
}]
],
DynamicModule[{fcn=Points},
Column[{
Dynamic[fcn[team]],Dynamic[fcn[x1[league]]],Dynamic[fcn[x2[league]]],Dynamic[fcn[x3[league]]],Dynamic[fcn[x4[league]]],Dynamic[fcn[x5[league]]],Dynamic[fcn[x6[league]]],Dynamic[fcn[x7[league]]],Dynamic[fcn[x8[league]]],Dynamic[fcn[x9[league]]],Dynamic[fcn[x10[league]]],Dynamic[fcn[x11[league]]],Dynamic[fcn[x12[league]]],Dynamic[fcn[x13[league]]],Dynamic[fcn[x14[league]]],Dynamic[fcn[x15[league]]],Dynamic[fcn[x16[league]]],Dynamic[fcn[x17[league]]],Dynamic[fcn[x18[league]]],Dynamic[fcn[x19[league]]],Dynamic[fcn[x20[league]]]
}]
],
DynamicModule[{fcn=Wins},
Column[{
Dynamic[fcn[team]],Dynamic[fcn[x1[league]]],Dynamic[fcn[x2[league]]],Dynamic[fcn[x3[league]]],Dynamic[fcn[x4[league]]],Dynamic[fcn[x5[league]]],Dynamic[fcn[x6[league]]],Dynamic[fcn[x7[league]]],Dynamic[fcn[x8[league]]],Dynamic[fcn[x9[league]]],Dynamic[fcn[x10[league]]],Dynamic[fcn[x11[league]]],Dynamic[fcn[x12[league]]],Dynamic[fcn[x13[league]]],Dynamic[fcn[x14[league]]],Dynamic[fcn[x15[league]]],Dynamic[fcn[x16[league]]],Dynamic[fcn[x17[league]]],Dynamic[fcn[x18[league]]],Dynamic[fcn[x19[league]]],Dynamic[fcn[x20[league]]]
}]
],
DynamicModule[{fcn=Draws},
Column[{
Dynamic[fcn[team]],Dynamic[fcn[x1[league]]],Dynamic[fcn[x2[league]]],Dynamic[fcn[x3[league]]],Dynamic[fcn[x4[league]]],Dynamic[fcn[x5[league]]],Dynamic[fcn[x6[league]]],Dynamic[fcn[x7[league]]],Dynamic[fcn[x8[league]]],Dynamic[fcn[x9[league]]],Dynamic[fcn[x10[league]]],Dynamic[fcn[x11[league]]],Dynamic[fcn[x12[league]]],Dynamic[fcn[x13[league]]],Dynamic[fcn[x14[league]]],Dynamic[fcn[x15[league]]],Dynamic[fcn[x16[league]]],Dynamic[fcn[x17[league]]],Dynamic[fcn[x18[league]]],Dynamic[fcn[x19[league]]],Dynamic[fcn[x20[league]]]
}]
],
DynamicModule[{fcn=Losses},
Column[{
Dynamic[fcn[team]],Dynamic[fcn[x1[league]]],Dynamic[fcn[x2[league]]],Dynamic[fcn[x3[league]]],Dynamic[fcn[x4[league]]],Dynamic[fcn[x5[league]]],Dynamic[fcn[x6[league]]],Dynamic[fcn[x7[league]]],Dynamic[fcn[x8[league]]],Dynamic[fcn[x9[league]]],Dynamic[fcn[x10[league]]],Dynamic[fcn[x11[league]]],Dynamic[fcn[x12[league]]],Dynamic[fcn[x13[league]]],Dynamic[fcn[x14[league]]],Dynamic[fcn[x15[league]]],Dynamic[fcn[x16[league]]],Dynamic[fcn[x17[league]]],Dynamic[fcn[x18[league]]],Dynamic[fcn[x19[league]]],Dynamic[fcn[x20[league]]]
}]
],
DynamicModule[{fcn=Goals},
Column[{
Dynamic[fcn[team]],Dynamic[fcn[x1[league]]],Dynamic[fcn[x2[league]]],Dynamic[fcn[x3[league]]],Dynamic[fcn[x4[league]]],Dynamic[fcn[x5[league]]],Dynamic[fcn[x6[league]]],Dynamic[fcn[x7[league]]],Dynamic[fcn[x8[league]]],Dynamic[fcn[x9[league]]],Dynamic[fcn[x10[league]]],Dynamic[fcn[x11[league]]],Dynamic[fcn[x12[league]]],Dynamic[fcn[x13[league]]],Dynamic[fcn[x14[league]]],Dynamic[fcn[x15[league]]],Dynamic[fcn[x16[league]]],Dynamic[fcn[x17[league]]],Dynamic[fcn[x18[league]]],Dynamic[fcn[x19[league]]],Dynamic[fcn[x20[league]]]
}]
],
DynamicModule[{fcn=Allowed},
Column[{
Dynamic[fcn[team]],Dynamic[fcn[x1[league]]],Dynamic[fcn[x2[league]]],Dynamic[fcn[x3[league]]],Dynamic[fcn[x4[league]]],Dynamic[fcn[x5[league]]],Dynamic[fcn[x6[league]]],Dynamic[fcn[x7[league]]],Dynamic[fcn[x8[league]]],Dynamic[fcn[x9[league]]],Dynamic[fcn[x10[league]]],Dynamic[fcn[x11[league]]],Dynamic[fcn[x12[league]]],Dynamic[fcn[x13[league]]],Dynamic[fcn[x14[league]]],Dynamic[fcn[x15[league]]],Dynamic[fcn[x16[league]]],Dynamic[fcn[x17[league]]],Dynamic[fcn[x18[league]]],Dynamic[fcn[x19[league]]],Dynamic[fcn[x20[league]]]
}]
],
DynamicModule[{fcn=Differential},
Column[{
Dynamic[fcn[team]],Dynamic[fcn[x1[league]]],Dynamic[fcn[x2[league]]],Dynamic[fcn[x3[league]]],Dynamic[fcn[x4[league]]],Dynamic[fcn[x5[league]]],Dynamic[fcn[x6[league]]],Dynamic[fcn[x7[league]]],Dynamic[fcn[x8[league]]],Dynamic[fcn[x9[league]]],Dynamic[fcn[x10[league]]],Dynamic[fcn[x11[league]]],Dynamic[fcn[x12[league]]],Dynamic[fcn[x13[league]]],Dynamic[fcn[x14[league]]],Dynamic[fcn[x15[league]]],Dynamic[fcn[x16[league]]],Dynamic[fcn[x17[league]]],Dynamic[fcn[x18[league]]],Dynamic[fcn[x19[league]]],Dynamic[fcn[x20[league]]]
}]
]
}],
"",
"GP=Games Played, Pts.=Points, W=Wins, D=Draws, L=Losses, GS=Goals","Scored, GA=Goals Allowed, Diff.=Differential"
}];

tabchart[]:=TabView[{Premiership->chart[Premiership],"Serie A"->chart[SerieA],"La Liga"->chart[LaLiga]}];

PremiershipResults={
(*19.08.2006*)
{Sheffield,Liverpool,0,0},{Portsmouth,Blackburn,3,0},{Newcastle,Wigan,2,1},{Everton,Watford,2,1},{Reading,Middlesbrough,3,2},{Arsenal,AstonVilla,1,1},{WestHam,Charlton,3,1},{Bolton,Tottenham,2,0},
(*20.08.2006*)
{ManchesterUnited,Fulham,5,1},{Chelsea,ManchesterCity,3,0},
(*22.08.2006*)
{Watford,WestHam,1,1},{Tottenham,Sheffield,2,0},
(*23.08.2006*)
{ManchesterCity,Portsmouth,0,0},{AstonVilla,Reading,2,1},{Fulham,Bolton,1,1},{Blackburn,Everton,1,1},{Middlesbrough,Chelsea,2,1},{Charlton,ManchesterUnited,0,3},
(*26.08.2006*)
{Liverpool,WestHam,2,1},{Watford,ManchesterUnited,1,2},{Tottenham,Everton,0,2},{Wigan,Reading,1,0},{Fulham,Sheffield,1,0},{Charlton,Bolton,2,0},{ManchesterCity,Arsenal,1,0},
(*27.08.2006*)
{AstonVilla,Newcastle,2,0},{Blackburn,Chelsea,0,2},
(*28.08.2006*)
{Middlesbrough,Portsmouth,0,4},
(*09.09.2006*)
{Everton,Liverpool,3,0},{Newcastle,Fulham,1,2},{Sheffield,Blackburn,0,0},{Arsenal,Middlesbrough,1,1},{Portsmouth,Wigan,1,0},{Chelsea,Charlton,2,1},{Bolton,Watford,1,0},{ManchesterUnited,Tottenham,1,0},
(*10.09.2006*)
{WestHam,AstonVilla,1,1},
(*11.09.2006*)
{Reading,ManchesterCity,1,0},
(*16.09.2006*)
{Charlton,Portsmouth,0,1},{Sheffield,Reading,1,2},{Everton,Wigan,2,2},{Bolton,Middlesbrough,0,0},{Watford,AstonVilla,0,0},
(*17.09.2006*)
{Chelsea,Liverpool,1,0},{Tottenham,Fulham,0,0},{WestHam,Newcastle,0,2},{Blackburn,ManchesterCity,4,2},{ManchesterUnited,Arsenal,0,1},
(*20.09.2006*)
{Liverpool,Newcastle,2,0},
(*23.09.2006*)
{Liverpool,Tottenham,3,0},{Fulham,Chelsea,0,2},{ManchesterCity,WestHam,2,0},{Middlesbrough,Blackburn,0,1},{Wigan,Watford,1,1},{AstonVilla,Charlton,2,0},{Arsenal,Sheffield,3,0},{Reading,ManchesterUnited,1,1},
(*24.09.2006*)
{Newcastle,Everton,1,1},
(*25.09.2006*)
{Portsmouth,Bolton,0,1},
(*30.09.2006*)
{Bolton,Liverpool,2,0},{Charlton,Arsenal,1,2},{Chelsea,AstonVilla,1,1},{Everton,ManchesterCity,1,1},{Sheffield,Middlesbrough,2,1},
(*01.10.2006*)
{WestHam,Reading,0,1},{ManchesterUnited,Newcastle,2,0},{Tottenham,Portsmouth,2,1},{Blackburn,Wigan,2,1},
(*01.10.2006*)
{Watford,Fulham,3,3}
};
SerieAResults={
(*09.09.2004*)
{ASRoma,Livorno,2,0},{Fiorentina,InterMilan,2,3},
(*10*09*2006*)
{Messina,Udinese,1,0},{ACMilan,Lazio,2,0},{Palermo,Reggina,4,3},{Sampdoria,Empoli,1,2},{ChievoVerona,Siena,1,2},{Cagliari,Catania,0,1},{Atalanta,Ascoli,3,1},{Torino,Parma,1,1},
(*16.09.2006*)
{Reggina,Cagliari,2,1},{InterMilan,Sampdoria,1,1},
(*17.09.2006*)
{Empoli,ChievoVerona,1,1},{Livorno,Fiorentina,1,0},{Udinese,Torino,2,0},{Ascoli,Messina,1,1},{Siena,ASRoma,1,3},{Lazio,Palermo,1,2},{Catania,Atalanta,0,0},{Parma,ACMilan,0,2},
(*20.09.2006*)
{Torino,Siena,1,2},{Cagliari,Livorno,2,2},{ChievoVerona,Lazio,0,1},{Fiorentina,Parma,1,0},{Messina,Reggina,2,0},{ACMilan,Ascoli,1,0},{Palermo,Catania,5,3},{ASRoma,InterMilan,0,1},{Sampdoria,Udinese,3,3},{Atalanta,Empoli,0,0},
(*23.09.2006*)
{Livorno,ACMilan,0,0},{Catania,Messina,2,2},
(*24.09.2006*)
{Lazio,Atalanta,1,0},{Parma,ASRoma,0,4},{Inter,ChievoVerona,4,3},{Empoli,Palermo,2,0},{Reggina,Torino,1,1},{Siena,Cagliari,0,0},{Ascoli,Sampdoria,1,1},{Udinese,Fiorentina,1,0},
(*30.09.2006*)
{Atalanta,Reggina,1,1},{Torino,Lazio,0,4},
(*01.10.2005*)
{Cagliari,InterMilan,1,1},{ACMilan,Siena,0,0},{Fiorentina,Catania,3,0},{Messina,Livorno,0,1},{ASRoma,Empoli,1,0},{Sampdoria,Parma,3,2},{Udinese,Ascoli,0,0},{ChievoVerona,Palermo,0,1}
};

Capture the Flag

2D- Dynamic Wrapper

DynamicModule[{xCont=0,yCont=-4,xCont2=0,yCont2=-4,
BLUECOUNT=0,
ALLOWBLUEFLAG=True,
ALLOWBLUETOUCH= True,
BLUESCORE = 0,
ALLOWBLUESCORE = True,
REDCOUNT=0,
ALLOWREDFLAG=True,
ALLOWREDTOUCH = True,
REDSCORE = 0,
ALLOWREDSCORE = True,

redPoint1  = {-2,4},
redPoint2  = {2,8},
bluePoint1  = {-2,-4},
bluePoint2  = {2,-8},
radius = 0.5,
radius2 = 5.5,
redSafeCenter = {0,-8},
blueSafeCenter= {0,8}
},

DynamicWrapper[
Graphics[{
(*field*)
{Green,Rectangle[{-8,-8},{8,0}]},
{Darker[Green,0.5],Rectangle[{-8,0},{8,8}]},
(*goal box*)
{Opacity[0],EdgeForm[Black],Rectangle[{-2,4},{2,8}]},
{Opacity[0],EdgeForm[Black],Rectangle[{-2,-4},{2,-8}]},
(*safe zone*)
{Opacity[0.3],Circle[{0,8},radius2-radius]},
{Opacity[0.3],Circle[{0,-8},radius2-radius]},

(*Blue Score*)
{Text[Style[Dynamic[StringJoin["Blue: ", ToString[BLUESCORE]]],12,Bold,FontFamily->"Arial",Black],{5.5,-6}]},
(*Red Score*)
{Text[Style[Dynamic[StringJoin["Red: ", ToString[REDSCORE]]],12,Bold,FontFamily->"Arial",Black],{5.5,6}]},
(*Blue Flag*)
{Opacity[Dynamic[If[BLUECOUNT ≥ 1,0,1]]],Blue, Rectangle[{-0.25,6.5},{0.25,6}]},
(*Red Flag*)
{Opacity[Dynamic[If[REDCOUNT ≥ 1,0,1]]],Red, Rectangle[{-0.25,-6.5},{0.25,-6}]},

(*Blue Player*)
{Opacity[Dynamic[If[BLUECOUNT ≥ 1,1,0.3]],Blue],Disk[Dynamic[{xCont,yCont}],radius]},
(*Blue Notice*)
{Text[Style["!",16,Bold,White,FontFamily->"Arial",Opacity[Dynamic[If[!(yCont≥-8&&yCont≤0),1-(Norm[Abs[xCont-xCont2]+Abs[yCont-yCont2]])/16,0]]]],Dynamic[{xCont,yCont}]]},

(*Red Player*)
{Opacity[Dynamic[If[REDCOUNT ≥ 1,1,0.3]],Red],Disk[Dynamic[{xCont2,yCont2}],radius]},
(*Red Notice*)
{Text[Style["!",16,Bold,White,FontFamily->"Arial",Opacity[Dynamic[If[(yCont2≥-8&&yCont2≤0),1-(Norm[Abs[xCont-xCont2]+Abs[yCont-yCont2]])/16,0]]]],Dynamic[{xCont2,yCont2}]]}
},
ImageSize->500,PlotRange->{{-8.5,8.5},{-8.5,8.5}}]

,

Module[{deltas=ControllerState[{"X1","Y1","X2","Y2"}]},
deltas=Map[If[Abs[#]<0.1,0,#]&,deltas];
{xCont,yCont,xCont2,yCont2}+=deltas;
{xCont,yCont,xCont2,yCont2}=Clip[{xCont,yCont,xCont2,yCont2},{-8,8}];
];

(*Detect if Blue enters the flag zone*)
If[ALLOWBLUEFLAG&&xCont≤2&&xCont≥-2&&yCont≥4&&yCont≤8,
++BLUECOUNT];
ALLOWBLUEFLAG=If[xCont≤2&&xCont≥-2&&yCont≥4&&yCont≤8,False,True];

(*Detect if Red enters the flag zone*)
If[ALLOWREDFLAG&&xCont2≤2&&xCont2≥-2&&yCont2≥-8&&yCont2≤-4,
++REDCOUNT];
ALLOWREDFLAG=If[xCont2≤2&&xCont2≥-2&&yCont2≥-8&&yCont2≤-4,False,True];

(*Detect if Red tags Blue and takes away the "flag"*)
If[BLUECOUNT ≠ 0 && ALLOWREDTOUCH && !(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&!(yCont≥-8&&yCont≤0),
BLUECOUNT=0];
ALLOWREDTOUCH=If[!(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&!(yCont≥-8&&yCont≤0),False,True];

(*Detect if Blue tags Red and takes away the "flag"*)
If[REDCOUNT ≠ 0 && ALLOWBLUETOUCH && !(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&yCont≥-8&&yCont≤0,
REDCOUNT=0];
ALLOWBLUETOUCH=If[!(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&yCont≥-8&&yCont≤0,False,True];

(*Detect if Blue returns the flag to Blue's side*)
If[ALLOWBLUESCORE && BLUECOUNT ≥ 1 &&yCont ≤ 0,
++BLUESCORE; BLUECOUNT = 0];
ALLOWBLUESCORE=If[yCont ≤ 0,False,True];

(*Detect if Red returns the flag to Red's side*)
If[ALLOWREDSCORE && REDCOUNT ≥ 1 &&yCont2 ≥ 0,
++REDSCORE;REDCOUNT = 0];
ALLOWREDSCORE=If[yCont2 ≥ 0,False,True];

(*Returns Blue back to starting location if tagged*)
If[!(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&!(yCont≥-8&&yCont≤0), 
xCont = 0; yCont = -4, 
xCont = xCont;yCont = yCont];

(*Returns Red back to starting location if tagged*)
If[!(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&(yCont≥-8&&yCont≤0), 
xCont2 = 0; yCont2 = 4, 
xCont2 = xCont2; yCont2 = yCont2];

(*Prevents Blue from going into Red's Safe Zone*)
If [Norm[{xCont,yCont}-redSafeCenter]>radius2,{xCont,yCont}= {xCont,yCont},{xCont,yCont}=redSafeCenter+(radius2*({xCont,yCont}-redSafeCenter))/Norm[({xCont,yCont}-redSafeCenter)]];

(*Prevents Red from going into Blue's Safe Zone*)
If [Norm[{xCont2,yCont2}-blueSafeCenter]>radius2,{xCont2,yCont2}= {xCont2,yCont2},{xCont2,yCont2}=blueSafeCenter+(radius2*({xCont2,yCont2}-blueSafeCenter))/Norm[({xCont2,yCont2}-blueSafeCenter)]];

]
]

2D V2 - All in One Dynamic Module

DynamicModule[{xCont=0,yCont=-4,xCont2=0,yCont2=-4,
BLUECOUNT=0,
ALLOWBLUEFLAG=True,
ALLOWBLUETOUCH= True,
BLUESCORE = 0,
ALLOWBLUESCORE = True,
REDCOUNT=0,
ALLOWREDFLAG=True,
ALLOWREDTOUCH = True,
REDSCORE = 0,
ALLOWREDSCORE = True,

redPoint1  = {-2,4},
redPoint2  = {2,8},
bluePoint1  = {-2,-4},
bluePoint2  = {2,-8},
radius = 0.5,
radius2 = 5.5,
redSafeCenter = {0,-8},
blueSafeCenter= {0,8}
},

Dynamic[
Module[{deltas=ControllerState[{"X1","Y1","X2","Y2"}]},
deltas=Map[If[Abs[#]<0.1,0,#]&,deltas];
{xCont,yCont,xCont2,yCont2}+=deltas;
{xCont,yCont,xCont2,yCont2}=Clip[{xCont,yCont,xCont2,yCont2},{-8,8}];
];

(*Detect if Blue enters the flag zone*)
If[ALLOWBLUEFLAG&&xCont≤2&&xCont≥-2&&yCont≥4&&yCont≤8,
++BLUECOUNT];
ALLOWBLUEFLAG=If[xCont≤2&&xCont≥-2&&yCont≥4&&yCont≤8,False,True];

(*Detect if Red enters the flag zone*)
If[ALLOWREDFLAG&&xCont2≤2&&xCont2≥-2&&yCont2≥-8&&yCont2≤-4,
++REDCOUNT];
ALLOWREDFLAG=If[xCont2≤2&&xCont2≥-2&&yCont2≥-8&&yCont2≤-4,False,True];

(*Detect if Red tags Blue and takes away the "flag"*)
If[BLUECOUNT ≠ 0 && ALLOWREDTOUCH && !(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&!(yCont≥-8&&yCont≤0),
BLUECOUNT=0];
ALLOWREDTOUCH=If[!(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&!(yCont≥-8&&yCont≤0),False,True];

(*Detect if Blue tags Red and takes away the "flag"*)
If[REDCOUNT ≠ 0 && ALLOWBLUETOUCH && !(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&yCont≥-8&&yCont≤0,
REDCOUNT=0];
ALLOWBLUETOUCH=If[!(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&yCont≥-8&&yCont≤0,False,True];

(*Detect if Blue returns the flag to Blue's side*)
If[ALLOWBLUESCORE && BLUECOUNT ≥ 1 &&yCont ≤ 0,
++BLUESCORE; BLUECOUNT = 0];
ALLOWBLUESCORE=If[yCont ≤ 0,False,True];

(*Detect if Red returns the flag to Red's side*)
If[ALLOWREDSCORE && REDCOUNT ≥ 1 &&yCont2 ≥ 0,
++REDSCORE;REDCOUNT = 0];
ALLOWREDSCORE=If[yCont2 ≥ 0,False,True];

(*Returns Blue back to starting location if tagged*)
If[!(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&!(yCont≥-8&&yCont≤0), 
xCont = 0; yCont = -4, 
xCont = xCont;yCont = yCont];

(*Returns Red back to starting location if tagged*)
If[!(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&(yCont≥-8&&yCont≤0), 
xCont2 = 0; yCont2 = 4, 
xCont2 = xCont2; yCont2 = yCont2];

(*Prevents Blue from going into Red's Safe Zone*)
If [Norm[{xCont,yCont}-redSafeCenter]>radius2,{xCont,yCont}= {xCont,yCont},{xCont,yCont}=redSafeCenter+(radius2*({xCont,yCont}-redSafeCenter))/Norm[({xCont,yCont}-redSafeCenter)]];

(*Prevents Red from going into Blue's Safe Zone*)
If [Norm[{xCont2,yCont2}-blueSafeCenter]>radius2,{xCont2,yCont2}= {xCont2,yCont2},{xCont2,yCont2}=blueSafeCenter+(radius2*({xCont2,yCont2}-blueSafeCenter))/Norm[({xCont2,yCont2}-blueSafeCenter)]];

Graphics[{
(*field*)
{Green,Rectangle[{-8,-8},{8,0}]},
{Darker[Green,0.5],Rectangle[{-8,0},{8,8}]},
(*goal box*)
{Opacity[0],EdgeForm[Black],Rectangle[{-2,4},{2,8}]},
{Opacity[0],EdgeForm[Black],Rectangle[{-2,-4},{2,-8}]},
(*safe zone*)
{Opacity[0.3],Circle[{0,8},radius2-radius]},
{Opacity[0.3],Circle[{0,-8},radius2-radius]},

(*Blue Score*)
{Text[Style[StringJoin["Blue: ", ToString[BLUESCORE]],12,Bold,FontFamily->"Arial",Black],{5.5,-6}]},
(*Red Score*)
{Text[Style[StringJoin["Red: ", ToString[REDSCORE]],12,Bold,FontFamily->"Arial",Black],{5.5,6}]},
(*Blue Flag*)
{Opacity[If[BLUECOUNT ≥ 1,0,1]],Blue, Rectangle[{-0.25,6.5},{0.25,6}]},
(*Red Flag*)
{Opacity[If[REDCOUNT ≥ 1,0,1]],Red, Rectangle[{-0.25,-6.5},{0.25,-6}]},

(*Blue Player*)
{Opacity[If[BLUECOUNT ≥ 1,1,0.3],Blue],Disk[{xCont,yCont},radius]},
(*Blue Notice*)
{Text[Style["!",16,Bold,White,FontFamily->"Arial",Opacity[If[!(yCont≥-8&&yCont≤0),1-(Norm[Abs[xCont-xCont2]+Abs[yCont-yCont2]])/16,0]]],{xCont,yCont}]},

(*Red Player*)
{Opacity[If[REDCOUNT ≥ 1,1,0.3],Red],Disk[{xCont2,yCont2},radius]},
(*Red Notice*)
{Text[Style["!",16,Bold,White,FontFamily->"Arial",Opacity[If[(yCont2≥-8&&yCont2≤0),1-(Norm[Abs[xCont-xCont2]+Abs[yCont-yCont2]])/16,0]]],{xCont2,yCont2}]}
},
ImageSize->500,PlotRange->{{-8.5,8.5},{-8.5,8.5}}]]
]

3D

DynamicModule[{xCont=0,yCont=-4,xCont2=0,yCont2=-4,
BLUECOUNT=0,
ALLOWBLUEFLAG=True,
ALLOWBLUETOUCH= True,
BLUESCORE = 0,
ALLOWBLUESCORE = True,
REDCOUNT=0,
ALLOWREDFLAG=True,
ALLOWREDTOUCH = True,
REDSCORE = 0,
ALLOWREDSCORE = True,

redPoint1  = {-2,4},
redPoint2  = {2,8},
bluePoint1  = {-2,-4},
bluePoint2  = {2,-8},
radius = 0.5,
radius2 = 5,
redSafeCenter = {0,-8},
blueSafeCenter= {0,8}
},

DynamicWrapper[
Graphics3D[{
(*safe zone*)
{Opacity[0.3],Cylinder[{{0,8,0},{0,8,1}},5]},
{Opacity[0.3],Cylinder[{{0,-8,0},{0,-8,1}},5]},
(*goal box*)
{Opacity[0],Cuboid[{-2,4,0.2},{2,8,0.8}]},
{Opacity[0],Cuboid[{-2,-4,0.2},{2,-8,0.8}]},
(*field*)
{Green, Cuboid[{-8,-8,-1},{8,0,0}]},
{Darker[Green,0.5],Cuboid[{-8,0,-1},{8,8,0}]},
(*Blue Score*)
{Text[Style[Dynamic[StringJoin["Blue: ", ToString[BLUESCORE]]],12,Bold,FontFamily->"Arial",Black],{5.5,-6,1}]},
(*Red Score*)
{Text[Style[Dynamic[StringJoin["Red: ", ToString[REDSCORE]]],12,Bold,FontFamily->"Arial",Black],{5.5,6,1}]},
(*Blue Flag*)
{Opacity[Dynamic[If[BLUECOUNT ≥ 1,0,1]]],Blue, Cuboid[{-0.25,6.5,0},{0.25,6,5}]},
(*Red Flag*)
{Opacity[Dynamic[If[REDCOUNT ≥ 1,0,1]]],Red, Cuboid[{-0.25,-6.5,0},{0.25,-6,5}]},
(*Blue Player*)
{Opacity[Dynamic[If[BLUECOUNT ≥ 1,1,0.3]],Blue],Sphere[Dynamic[{xCont,yCont,radius}],radius]},
(*Blue Notice*)
{Text[Style["!",16,Bold,White,FontFamily->"Arial",Opacity[Dynamic[If[!(yCont≥-8&&yCont≤0),1-(Norm[Abs[xCont-xCont2]+Abs[yCont-yCont2]])/16,0]]]],Dynamic[{xCont,yCont,radius}]]},

(*Red Player*)
{Opacity[Dynamic[If[REDCOUNT ≥ 1,1,0.3]],Red],Sphere[Dynamic[{xCont2,yCont2,radius}],radius]},
(*Red Notice*)
{Text[Style["!",16,Bold,White,FontFamily->"Arial",Opacity[Dynamic[If[(yCont2≥-8&&yCont2≤0),1-(Norm[Abs[xCont-xCont2]+Abs[yCont-yCont2]])/16,0]]]],Dynamic[{xCont2,yCont2,radius}]]}
},
ControllerLinking->False,Method->{"SpherePoints"->{8,8},"CylinderPoints"->{20,1}},Boxed->False,ImageSize->500,PlotRange->{{-8.5,8.5},{-8.5,8.5},Automatic}]

,

Module[{deltas=ControllerState[{"X1","Y1","X2","Y2"}]},
deltas=Map[If[Abs[#]<0.1,0,#]&,deltas];
{xCont,yCont,xCont2,yCont2}+=deltas;
{xCont,yCont,xCont2,yCont2}=Clip[{xCont,yCont,xCont2,yCont2},{-8,8}];
];

(*Detect if Blue enters the flag zone*)
If[ALLOWBLUEFLAG&&xCont≤2&&xCont≥-2&&yCont≥4&&yCont≤8,
++BLUECOUNT];
ALLOWBLUEFLAG=If[xCont≤2&&xCont≥-2&&yCont≥4&&yCont≤8,False,True];

(*Detect if Red enters the flag zone*)
If[ALLOWREDFLAG&&xCont2≤2&&xCont2≥-2&&yCont2≥-8&&yCont2≤-4,
++REDCOUNT];
ALLOWREDFLAG=If[xCont2≤2&&xCont2≥-2&&yCont2≥-8&&yCont2≤-4,False,True];

(*Detect if Red tags Blue and takes away the "flag"*)
If[BLUECOUNT ≠ 0 && ALLOWREDTOUCH && !(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&!(yCont≥-8&&yCont≤0),
BLUECOUNT=0];
ALLOWREDTOUCH=If[!(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&!(yCont≥-8&&yCont≤0),False,True];

(*Detect if Blue tags Red and takes away the "flag"*)
If[REDCOUNT ≠ 0 && ALLOWBLUETOUCH && !(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&yCont≥-8&&yCont≤0,
REDCOUNT=0];
ALLOWBLUETOUCH=If[!(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&yCont≥-8&&yCont≤0,False,True];

(*Detect if Blue returns the flag to Blue's side*)
If[ALLOWBLUESCORE && BLUECOUNT ≥ 1 &&yCont ≤ 0,
++BLUESCORE; BLUECOUNT = 0];
ALLOWBLUESCORE=If[yCont ≤ 0,False,True];

(*Detect if Red returns the flag to Red's side*)
If[ALLOWREDSCORE && REDCOUNT ≥ 1 &&yCont2 ≥ 0,
++REDSCORE;REDCOUNT = 0];
ALLOWREDSCORE=If[yCont2 ≥ 0,False,True];

(*Returns Blue back to starting location if tagged*)
If[!(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&!(yCont≥-8&&yCont≤0), 
xCont = 0; yCont = -4, 
xCont = xCont;yCont = yCont];

(*Returns Red back to starting location if tagged*)
If[!(Norm[{xCont,yCont}-{xCont2,yCont2}]>2*radius)&&(yCont≥-8&&yCont≤0), 
xCont2 = 0; yCont2 = 4, 
xCont2 = xCont2; yCont2 = yCont2];

(*Prevents Blue from going into Red's Safe Zone*)
If [Norm[{xCont,yCont}-redSafeCenter]>radius2,{xCont,yCont}= {xCont,yCont},{xCont,yCont}=redSafeCenter+(radius2*({xCont,yCont}-redSafeCenter))/Norm[({xCont,yCont}-redSafeCenter)]];

(*Prevents Red from going into Blue's Safe Zone*)
If [Norm[{xCont2,yCont2}-blueSafeCenter]>radius2,{xCont2,yCont2}= {xCont2,yCont2},{xCont2,yCont2}=blueSafeCenter+(radius2*({xCont2,yCont2}-blueSafeCenter))/Norm[({xCont2,yCont2}-blueSafeCenter)]];

]
]