(*^ ::[ Information = "This is a Mathematica Notebook file. It contains ASCII text, and can be transferred by email, ftp, or other text-file transfer utility. It should be read or edited using a copy of Mathematica or MathReader. If you received this as email, use your mail application or copy/paste to save everything from the line containing (*^ down to the line containing ^*) into a plain text file. On some systems you may have to give the file a name ending with ".ma" to allow Mathematica to recognize it as a Notebook. The line below identifies what version of Mathematica created this file, but it can be opened using any other version as well."; FrontEndVersion = "Macintosh Mathematica Notebook Front End Version 2.2"; MacintoshStandardFontEncoding; fontset = title, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e8, 24, "Times"; fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6, 18, "Times"; fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, e6, 14, "Times"; fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, a20, 18, "Times"; fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, a15, 14, "Times"; fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, a12, 12, "Times"; fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times"; fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L-5, 12, "Courier"; fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier"; fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, R65535, L-5, 12, "Courier"; fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier"; fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, B65535, L-5, 12, "Courier"; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, 12, "Courier"; fontset = name, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, 10, "Geneva"; fontset = header, inactive, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = leftheader, inactive, L2, 12, "Times"; fontset = footer, inactive, noKeepOnOnePage, preserveAspect, center, M7, 12, "Times"; fontset = leftfooter, inactive, L2, 12, "Times"; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times"; fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; paletteColors = 128; automaticGrouping; currentKernel; ] :[font = section; inactive; preserveAspect; startGroup] CHAPTER 8 :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] Procedures for use in evolutionary game theory :[font = text; inactive; preserveAspect] The package GameTheory contains four procedures, AllEquilibria, NashEquilibria, ESState and ESStrategy. Each procedure takes the payoff matrix of a game as its argument and returns a list of the corresponding equilibria. First read in the package and find further information about the procedues: ;[s] 11:0,0;12,1;22,0;49,1;62,0;64,1;78,0;80,1;87,0;92,1;102,0;297,-1; 2:6,13,9,Times,0,12,0,0,0;5,13,9,Times,1,12,0,0,0; :[font = input; preserveAspect] <0.5 :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 3 :[font = text; inactive; preserveAspect; endGroup] Use pencil and paper. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 4 :[font = text; inactive; preserveAspect] The following is a general method for studying dynamic stability :[font = input; preserveAspect] A={{0,5,-4},{-7,0,8},{-1,2,0}}; :[font = input; preserveAspect] Clear[p] freq=Array[p,3]; w=A.freq; wbar=w.freq; :[font = input; preserveAspect] jac=Table[D[(w[[i]]-wbar)p[i],p[j]] -D[(w[[i]]-wbar)p[i],p[3]], {i,2},{j,2}]; :[font = input; preserveAspect] Eigenvalues[jac/.{p[1]->1/3,p[2]->1/3,p[3]->1/3}] :[font = text; inactive; preserveAspect] We now calculate the payoffs for strategies I and J :[font = input; preserveAspect] stratI={1/3,1/3,1/3}; stratJ={0,1/2,1/2}; :[font = input; preserveAspect] stratI.A.stratI :[font = input; preserveAspect] stratJ.A.stratI :[font = input; preserveAspect] stratI.A.stratJ :[font = input; preserveAspect; endGroup] stratJ.A.stratJ :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 5 :[font = text; inactive; preserveAspect] The following program solves the continuous time differential equation numerically from an appropriate set of initial values. [This calculation uses a lot of memory. If you don't have enough, reduce the time span to, say, 5.] :[font = input; preserveAspect; endGroup] A={{1,10,-10},{-10,1,10},{10,-10,1}}; x={p[t],q[t],r[t]}; w=100+A.x/.r[t]->1-p[t]-q[t]; wbar=w.x/.r[t]->1-p[t]-q[t]; soln=NDSolve[{p'[t]==(w[[1]]-wbar) p[t], q'[t]==(w[[2]]-wbar) q[t], p[0]==q[0]==.2}, {p,q},{t,10}] Plot[Evaluate[p[t]/.soln],{t,0,10}] Plot[Evaluate[q[t]/.soln],{t,0,10}] Plot[Evaluate[1-p[t]-q[t]/.soln],{t,0,10}] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 6 :[font = text; inactive; preserveAspect] I use the game with payoff matrix (9) as an example: :[font = input; preserveAspect] A={{1,4},{0,2}}; :[font = input; preserveAspect] NashEquilibria[A] :[font = input; preserveAspect] ESState[A] :[font = input; preserveAspect; endGroup] ESStrategy[A] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 7, 8, 9, 10 :[font = text; inactive; preserveAspect; endGroup] Use pencil and paper. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 11 :[font = text; inactive; preserveAspect] Find the equilibrium value: :[font = input; preserveAspect] w=(1-(1-x)(1-y)/2)(1-x^2); :[font = input; preserveAspect] diff=D[w,x]/.y->x :[font = input; preserveAspect] vstar=x/.FindRoot[diff==0,{x,.5}] :[font = text; inactive; preserveAspect] Check that it is a Nash equilibrium: :[font = input; preserveAspect] D[w,{x,2}]/.{x->vstar,y->vstar} :[font = text; inactive; preserveAspect] Check for continuous stability: :[font = input; preserveAspect] D[w,{x,2}]+D[w,x,y]/.{x->vstar,y->vstar} :[font = text; inactive; preserveAspect] Plot the best-reply function: :[font = input; preserveAspect] d=D[w,x] :[font = input; preserveAspect] v[y_]:=x/.FindRoot[d==0,{x,.5}] :[font = input; preserveAspect; endGroup; endGroup] Plot[{v[y],y},{y,0.01,0.99}] ^*)