(* Content-type: application/mathematica *)

(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)

(* CreatedBy='Mathematica 6.0' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       145,          7]
NotebookDataLength[     14453,        387]
NotebookOptionsPosition[     12974,        333]
NotebookOutlinePosition[     13638,        359]
CellTagsIndexPosition[     13595,        356]
WindowFrame->Normal
ContainsDynamic->False*)

(* Beginning of Notebook Content *)
Notebook[{
Cell[BoxData[{
 RowBox[{"ai", "=."}], "\n", 
 RowBox[{"ares", "=."}], "\n", 
 RowBox[{"astar", "=."}], "\[IndentingNewLine]", 
 RowBox[{"R", "=."}], "\n", 
 RowBox[{"Wi", "=."}], "\[IndentingNewLine]", 
 RowBox[{"Cd", "=."}], "\[IndentingNewLine]", 
 RowBox[{"Noffspring", "=."}], "\[IndentingNewLine]"}], "Input",
 CellChangeTimes->{{3.431853614586442*^9, 3.431853621502324*^9}, {
  3.431890441944634*^9, 3.431890509409877*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[TextData[StyleBox["\nVariables are defined as in class, except that \
Noffspring is the number of offspring produced by each females.  As you will \
see, this is a constant, and drops out of the solution.  \n\nThis is Fisher's \
sex allocation problem.  We what to show that the solution ares=1/2 is a \
CSS.",
 FontSize->18]], "Text",
 CellChangeTimes->{{3.431856707367506*^9, 3.431856765718807*^9}, {
  3.4318592164647923`*^9, 3.4318592180518312`*^9}, {3.4318907030500517`*^9, 
  3.4318907608780613`*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Wi", "=", 
  RowBox[{"Noffspring", 
   RowBox[{"(", 
    RowBox[{
     FractionBox[
      RowBox[{"R", " ", 
       RowBox[{"(", 
        RowBox[{"1", "-", "ai"}], ")"}]}], "Cd"], "+", 
     RowBox[{
      FractionBox[
       RowBox[{"R", " ", 
        RowBox[{"(", "ai", ")"}]}], "Cs"], 
      RowBox[{"(", 
       FractionBox[
        RowBox[{
         RowBox[{"(", 
          RowBox[{"1", "-", "ares"}], ")"}], "/", "Cd"}], 
        RowBox[{
         RowBox[{"(", "ares", ")"}], "/", "Cs"}]], ")"}]}]}], 
    ")"}]}]}]], "Input",
 CellChangeTimes->{{3.4318536494773293`*^9, 3.431853730246876*^9}, {
  3.4318565164247417`*^9, 3.431856523438698*^9}, {3.431890430757565*^9, 
  3.431890512505766*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"Noffspring", " ", 
  RowBox[{"(", 
   RowBox[{
    FractionBox[
     RowBox[{
      RowBox[{"(", 
       RowBox[{"1", "-", "ai"}], ")"}], " ", "R"}], "Cd"], "+", 
    FractionBox[
     RowBox[{"ai", " ", 
      RowBox[{"(", 
       RowBox[{"1", "-", "ares"}], ")"}], " ", "R"}], 
     RowBox[{"ares", " ", "Cd"}]]}], ")"}]}]], "Output",
 CellChangeTimes->{
  3.431851907137629*^9, 3.4318537498894367`*^9, 3.431854063632985*^9, 
   3.431854759962821*^9, 3.4318553741537733`*^9, 3.431855848055032*^9, 
   3.4318560212070637`*^9, 3.4318565280356283`*^9, 3.431856896963315*^9, 
   3.431857456633143*^9, {3.431857499348576*^9, 3.431857523703209*^9}, {
   3.4318904987010517`*^9, 3.4318905194109983`*^9}}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Firstder", "=", 
  RowBox[{"D", "[", 
   RowBox[{"Wi", ",", " ", "ai"}], "]"}]}]], "Input",
 CellChangeTimes->{{3.431857485364313*^9, 3.431857493572278*^9}},
 ImageRegion->{{0, 1}, {0, 1}}],

Cell[BoxData[
 RowBox[{"Noffspring", " ", 
  RowBox[{"(", 
   RowBox[{
    RowBox[{"-", 
     FractionBox["R", "Cd"]}], "+", 
    FractionBox[
     RowBox[{
      RowBox[{"(", 
       RowBox[{"1", "-", "ares"}], ")"}], " ", "R"}], 
     RowBox[{"ares", " ", "Cd"}]]}], ")"}]}]], "Output",
 CellChangeTimes->{
  3.4318519101526423`*^9, 3.431853756789969*^9, 3.431854065794312*^9, 
   3.431854762861828*^9, 3.4318553742678127`*^9, 3.431855856812611*^9, 
   3.431856021258967*^9, 3.431856547307046*^9, 3.431856899329116*^9, 
   3.4318574566762753`*^9, {3.431857495516157*^9, 3.431857523760881*^9}, {
   3.43189050123312*^9, 3.431890522833356*^9}}]
}, Open  ]],

Cell[TextData[StyleBox["\n\nNow we want to determine the effect of ares on \
the firstderivative in order to evaluate convergence stability.  Note that \
the first derivative is equal to zero at ares = 1/2.  Also note that the \
slope is negative at that point.  Hence, the solution ares=1/2 is convergence \
stable.  That means that if the population is away from ares=1/2, mutants \
that are closer to 1/2 will be favored by selection, and the population will \
converge on the equilibrium of one half.  ",
 FontSize->18]], "Text",
 CellChangeTimes->{{3.431853843745894*^9, 3.431853879948618*^9}, {
  3.4318549939309196`*^9, 3.431854994616646*^9}, {3.4318908271372433`*^9, 
  3.4318908758359623`*^9}}],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{
  RowBox[{"Noffspring", "=", "5"}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"R", "=", "1"}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Cd", "=", 
   RowBox[{"1", "/", "10"}]}], ";"}], "\[IndentingNewLine]", 
 RowBox[{"Firstder", "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{"Plot", "[", 
  RowBox[{"Firstder", ",", " ", 
   RowBox[{"{", 
    RowBox[{"ares", ",", " ", "0.2", ",", " ", "0.8"}], "}"}]}], 
  "]"}]}], "Input",
 CellChangeTimes->{{3.431853797304208*^9, 3.431853797893559*^9}, {
   3.431854899832388*^9, 3.431854919311926*^9}, {3.431855200225339*^9, 
   3.431855210022169*^9}, 3.431855259458639*^9, {3.431855352752275*^9, 
   3.431855353110079*^9}, {3.431855384128693*^9, 3.43185538917354*^9}, {
   3.4318554648564453`*^9, 3.4318554712213297`*^9}, {3.431855518783976*^9, 
   3.431855519844775*^9}, {3.43185591746699*^9, 3.431855940772058*^9}, {
   3.431856564480538*^9, 3.431856565094767*^9}, {3.431890541985971*^9, 
   3.431890577107397*^9}}],

Cell[BoxData[
 RowBox[{"5", " ", 
  RowBox[{"(", 
   RowBox[{
    RowBox[{"-", "10"}], "+", 
    FractionBox[
     RowBox[{"10", " ", 
      RowBox[{"(", 
       RowBox[{"1", "-", "ares"}], ")"}]}], "ares"]}], ")"}]}]], "Output",
 CellChangeTimes->{{3.4318538072500143`*^9, 3.431853831833585*^9}, 
   3.431853887100528*^9, {3.431854907045053*^9, 3.4318549204438257`*^9}, 
   3.431855080039927*^9, {3.431855202247986*^9, 3.431855212812873*^9}, 
   3.431855260196966*^9, {3.431855354409459*^9, 3.431855401357974*^9}, 
   3.4318554717266073`*^9, 3.431855520647537*^9, 3.4318558780141287`*^9, {
   3.431855922630725*^9, 3.431855941802856*^9}, 3.431856021400449*^9, 
   3.431856215587473*^9, 3.431856570905726*^9, 3.43185690782549*^9, 
   3.431857456762443*^9, {3.4318574994997787`*^9, 3.431857523872038*^9}, {
   3.431890551177334*^9, 3.431890577928521*^9}}],

Cell[BoxData[
 GraphicsBox[{{}, {}, 
   {Hue[0.67, 0.6, 0.6], LineBox[CompressedData["
1:eJwVx3k4FGgcwHFUNmNtKSMhhSIbSQ05Wr/X1Fo9aTbSPLIJsw+TLsmxZStK
xdJIkmZ6xm163MyapHHMq11NEylHQ4QhM4hWxzKd7Lt/fJ/v8zFnRfiGamlo
aDBI/1+2W1nD48mgIks1NC9hobj8/AP5uTJINZzyENSxkO1M4KISgQzERg4r
GUIWSufLmXVCGWwoalhVWsBC/pPSj3KZDKYDNrqlXmIhVXIpGHySQVzAWeH0
LhZa8HdEa1rAI5gbDGQ49IegH1w/jSSatIKWn8zSdEEIat/ibzza2AbbpIzt
lLKDaGmNpyhlRzuIY9+tufriF2SlrMhI+usJCM+Y6W4K2o9sl1VtOyt8CrfY
oeMhU0yUHf3z8P6oDmgoMVg71+OH+IEGKZE/dkKFo7Kw/6Ev0s6j7hMt74I7
QVf1Yqb3IK91QT7G3V1QYkaPNhEykJHDY5/6om44PJzYxz+/CzXHJybGs5/B
ep3Csf3YC3Vbx/Yct5IDlVOl/OrmiWKYHHvejBxmYiKdnaq3o2npVJ2qtgcs
/wgbtTnlgdSSE54Ryb1QLregdUe4o3B9h1kL5nNQHL8ULvd2RSKBS89Hah+0
PLtRplnuhDg4rEFX1Qe5HTp6K9WbkbvZi05U3A+HE79mxrLt0Vmt2NfVcS8g
Z4s4JfPeemSNvL/33jkA7Py3NKdkC1SCD3MplEFY9ji+i2JqjO5JKygL+wfh
iti4yqtcDxXou1SuyRkC7sX75o/838PvARquoo0KcLYsPynReSc5GjGbE5Ol
AO55DfER/2+xTJDO91IrwMhRkbTqgSE+tvoHU5fgYUhRZ13eW74aS1u+sQPp
MHwWgSBIcy3mcGLlTOsRYJwWFVuIrfEtrlrzytUReOrUa9Z+cwNe3mL6oPPN
CIgj9Y7S9eyxh1mwif2elzBQeXCf2NoB14rvvCu++xJSTdfbnevbjLmnqlg0
o1HAvQWTB4JpuPl0vd9Awij0JFQLHs86Yib/yNDNkVHoy8ppnfl1K86bdPnM
pishY/tlH9dGZ+xwzpi3r1QJd5dknUdWrnjj5twnfroq8KQFF2854oajbJyS
I6NVoK28TJtp2oaP7Z7sKOxXwWyov1Cg4Y67MnaIxtzGAB2sqi+1AJxgUm20
s2gMet1dpgJsEOa1SKgNi8bhQ2NZS+6fCLP5rwt3hI5DelkTXcfRA5+ptRO9
ahsHgwyPEMMmDzz3Vj+wwG4CbgRnp8270LH0xOLk37ImIFu7PNK2gY5rw2lL
LxI7n85udiO+zQrmphM7TcXr7yK+6FdXXEJc3LVCGE6MnA/J+omfl16fvk1c
Ny+loJsT0MSpDzdvpOPStCTOYu4EYEmbr2ETHfOSaqhU4hXhg3nriJMThrLN
ia9Rh/+hEYed3FrpSux+6l7KXmJL5lj7UeL3YbXN6cT8VT8t7SD+8kVhqyuh
41TDKO4AsXhEK86YOG5J7ppXxB/aqFIbYn9N9aYFvAnwrfouxIuYqrzt40is
qPDOvES8cLDzuQexvnhWkUn8r3wuhEEc3XrNroi48yHzJJvYau7Wg/vEzc0X
PkUR563WWd5JXC2uvJBAXOR5KGiYOLemj8Ih9oqqK3tDnFaufZ1HnC/4qJ4n
/g/PpHn7
     "]]}},
  AspectRatio->NCache[GoldenRatio^(-1), 0.6180339887498948],
  Axes->True,
  AxesOrigin->{0.2, 0},
  ImageSize->{473.59999999999985`, Automatic},
  PlotRange->{{0.2, 0.8}, {-37.49999904336733, 149.99998469387847`}},
  PlotRangeClipping->True,
  PlotRangePadding->{
    Scaled[0.02], 
    Scaled[0.02]}]], "Output",
 CellChangeTimes->{{3.4318538072500143`*^9, 3.431853831833585*^9}, 
   3.431853887100528*^9, {3.431854907045053*^9, 3.4318549204438257`*^9}, 
   3.431855080039927*^9, {3.431855202247986*^9, 3.431855212812873*^9}, 
   3.431855260196966*^9, {3.431855354409459*^9, 3.431855401357974*^9}, 
   3.4318554717266073`*^9, 3.431855520647537*^9, 3.4318558780141287`*^9, {
   3.431855922630725*^9, 3.431855941802856*^9}, 3.431856021400449*^9, 
   3.431856215587473*^9, 3.431856570905726*^9, 3.43185690782549*^9, 
   3.431857456762443*^9, {3.4318574994997787`*^9, 3.431857523872038*^9}, {
   3.431890551177334*^9, 3.431890577940411*^9}}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{"Noffspring", "=."}], "\[IndentingNewLine]", 
 RowBox[{"R", "=."}], "\[IndentingNewLine]", 
 RowBox[{"Cd", "=."}], "\[IndentingNewLine]", 
 RowBox[{"Cs", "=."}], "\[IndentingNewLine]", 
 RowBox[{"CSS", " ", "=", " ", 
  RowBox[{"D", "[", 
   RowBox[{"Firstder", ",", " ", "ares"}], 
   "]"}]}], "\[IndentingNewLine]"}], "Input",
 CellChangeTimes->{{3.431855605664225*^9, 3.431855617252171*^9}, {
  3.431855660694624*^9, 3.43185566198001*^9}, {3.4318905855295258`*^9, 
  3.431890589991519*^9}}],

Cell[BoxData[
 RowBox[{"Noffspring", " ", 
  RowBox[{"(", 
   RowBox[{
    RowBox[{"-", 
     FractionBox[
      RowBox[{
       RowBox[{"(", 
        RowBox[{"1", "-", "ares"}], ")"}], " ", "R"}], 
      RowBox[{
       SuperscriptBox["ares", "2"], " ", "Cd"}]]}], "-", 
    FractionBox["R", 
     RowBox[{"ares", " ", "Cd"}]]}], ")"}]}]], "Output",
 CellChangeTimes->{
  3.431851981875051*^9, {3.431855609376864*^9, 3.431855618153729*^9}, {
   3.431855662799342*^9, 3.431855683044786*^9}, 3.4318560214606256`*^9, 
   3.4318564567856007`*^9, 3.4318566146165123`*^9, 3.4318569144334917`*^9, 
   3.431857456802678*^9, {3.431857499541069*^9, 3.431857523911624*^9}, 
   3.431890591081465*^9}]
}, Open  ]],

Cell[TextData[StyleBox["\nBelow we prove that the equilibrium is at ares=1/2. \
 ",
 FontSize->18]], "Text",
 CellChangeTimes->{{3.431856634919352*^9, 3.431856640236959*^9}, {
  3.431856928950172*^9, 3.4318569293149977`*^9}, {3.431890640305881*^9, 
  3.4318906445898314`*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Reduce", "[", 
  RowBox[{
   RowBox[{"Firstder", "\[Equal]", "0"}], ",", "ares"}], "]"}]], "Input",
 CellChangeTimes->{{3.431856651565463*^9, 3.4318566520690937`*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"(", 
   RowBox[{
    RowBox[{"ares", "\[Equal]", 
     FractionBox["1", "2"]}], "&&", 
    RowBox[{"Cd", "\[NotEqual]", "0"}]}], ")"}], "||", 
  RowBox[{"(", 
   RowBox[{
    RowBox[{"Noffspring", "\[Equal]", "0"}], "&&", 
    RowBox[{
     RowBox[{"ares", " ", "Cd"}], "\[NotEqual]", "0"}]}], ")"}], "||", 
  RowBox[{"(", 
   RowBox[{
    RowBox[{"R", "\[Equal]", "0"}], "&&", 
    RowBox[{
     RowBox[{"ares", " ", "Cd"}], "\[NotEqual]", "0"}]}], ")"}]}]], "Output",
 CellChangeTimes->{
  3.43185199225235*^9, 3.431856021932137*^9, {3.4318566424863977`*^9, 
   3.43185665766259*^9}, 3.431856934872635*^9, 3.4318574568701477`*^9, {
   3.431857499611929*^9, 3.431857523979704*^9}, 3.431890647314393*^9}]
}, Open  ]],

Cell[TextData[StyleBox["\nNow we want to determine whether ai =1/2 is an ESS. \
  ",
 FontSize->18]], "Text",
 CellChangeTimes->{{3.431856634919352*^9, 3.431856640236959*^9}, {
  3.431856928950172*^9, 3.4318569293149977`*^9}, {3.431890640305881*^9, 
  3.4318906445898314`*^9}, {3.431890965741827*^9, 3.43189099521929*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"\[IndentingNewLine]", 
  RowBox[{
   RowBox[{"Secondder", "=", " ", 
    RowBox[{"D", "[", 
     RowBox[{"Firstder", ",", " ", "ai"}], "]"}]}], 
   "\[IndentingNewLine]"}]}]], "Input"],

Cell[BoxData["0"], "Output",
 CellChangeTimes->{
  3.431851994705031*^9, 3.431856021979368*^9, 3.431856661213431*^9, 
   3.4318569370607443`*^9, 3.4318574569191647`*^9, {3.431857499677813*^9, 
   3.431857524012196*^9}, 3.43189065917743*^9}]
}, Open  ]],

Cell[TextData[StyleBox["Note that the second derivative (above) is zero.  So \
the equilibrium is convergent stable, but not evolutionarily stable.  Thus \
there will be drift at the equilibrium of 1/2, but if the population mean \
drifts away from 1/2, selection will tend to move the population back to one \
half (since the solution is convergence stable).",
 FontSize->18]], "Text"]
},
ScreenStyleEnvironment->"Presentation",
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{956, 743},
WindowMargins->{{63, Automatic}, {Automatic, 0}},
PrintingCopies->1,
PrintingPageRange->{1, Automatic},
PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}},
ShowCellLabel->True,
ShowCellTags->False,
RenderingOptions->{"ObjectDithering"->True,
"RasterDithering"->False},
Magnification->1.25,
FrontEndVersion->"6.0 for Mac OS X x86 (32-bit) (March 13, 2008)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[568, 21, 461, 10, 218, "Input"],
Cell[1032, 33, 512, 8, 160, "Text"],
Cell[CellGroupData[{
Cell[1569, 45, 756, 24, 74, "Input"],
Cell[2328, 71, 723, 18, 68, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[3088, 94, 213, 5, 42, "Input"],
Cell[3304, 101, 644, 16, 66, "Output"]
}, Open  ]],
Cell[3963, 120, 703, 10, 217, "Text"],
Cell[CellGroupData[{
Cell[4691, 134, 1014, 21, 168, "Input"],
Cell[5708, 157, 854, 17, 66, "Output"],
Cell[6565, 176, 2696, 49, 382, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[9298, 230, 517, 11, 168, "Input"],
Cell[9818, 243, 689, 18, 68, "Output"]
}, Open  ]],
Cell[10522, 264, 276, 5, 76, "Text"],
Cell[CellGroupData[{
Cell[10823, 273, 191, 4, 42, "Input"],
Cell[11017, 279, 739, 20, 92, "Output"]
}, Open  ]],
Cell[11771, 302, 322, 5, 76, "Text"],
Cell[CellGroupData[{
Cell[12118, 311, 208, 6, 93, "Input"],
Cell[12329, 319, 240, 4, 42, "Output"]
}, Open  ]],
Cell[12584, 326, 386, 5, 132, "Text"]
}
]
*)

(* End of internal cache information *)