You are using a browser not supported by the Wolfram Cloud
Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.
I understand and wish to continue anyway »
WOLFRAM NOTEBOOK
In[]:=
Nearest[Values[changeFitness[{2,2},$LifetimeData[2,2,"Symmetric"],Function[Divide@@Dimensions[DeleteCases[#,{0...}]]]]]]
Out[]=
NearestFunction
In[]:=
%65/@Range[.6,1.2,.1]
Out[]=
,,,,,,,,,,,,,,{1,1,1,1,1,1,1,1,1,1,1},,,,
3
5
3
5
8
11
8
11
8
11
8
11
4
5
4
5
4
5
4
5
4
5
4
5
4
5
26
29
10
9
10
9
10
9
23
19
In[]:=
First/@%
Out[]=
,,,,1,,
3
5
8
11
4
5
26
29
10
9
23
19
In[]:=
(1-ColorData["SunsetColors"][#])&[.5]
Out[]=
1-
In[]:=
gensMarkovWeights
Out[]=
In[]:=
Histogram[Flatten[Log[1+gensMarkovWeights]],Automatic,{"Log","Count"}]
Out[]=
In[]:=
rulesMarkovMatrix=N[MarkovWeights/Total/@MarkovWeights];
In[]:=
MatrixPlot[rulesMarkovMatrix,FrameTicks->None]
Out[]=
Morphospace
Morphospace
In[]:=
Take[dimensionReductionFull,5]
Out[]=
0{3.9752,1.53238},20{3.61602,4.98802},272{5.4246,2.37197},276{3.91832,5.04402},16788{3.81199,5.15403}
In[]:=
Take[$LifetimeData[2,2,"All"],10]
Out[]=
{0,65815}0,{20,16847199}1,{272,16847199}1,{276,285295007}1,{16788,285299167}2,{1048868,156317055}2,{1049892,3507586495}2,{268452116,285299167}2,{1082788,3507590655}3,{135274788,156317055}3
In[]:=
Take[heightPhenotypesFull,5]
Out[]=
{{0,65815},{276,285295007},{1049892,3507586495},{269484468,424769023},{1343260068,3646010879}}
ListPlot[Lookup[dimensionReductionFull,heightPhenotypesFull[[All,1]]],Axes->False,AspectRatio->1/GoldenRatio]
In[]:=
ListPlot[MapThread[Style[#1,Blend[{Blue,Blue,Red},(#2/309.)^.2]]&,{Lookup[dimensionReductionFull,heightPhenotypesFull[[All,1]]],Lookup[$LifetimeData[2,2,"All"],heightPhenotypesFull]}],Axes->False,AspectRatio->1/GoldenRatio,Frame->True,FrameStyle->Gray,FrameTicks->None]
Out[]=
In[]:=
ListPlot[MapThread[Style[#1,Blend[{Blue,Blue,Red},(#2/309.)^.2]]&,{Lookup[dimensionReductionFull,widthPhenotypesFull[[All,1]]],Lookup[changeFitness[{2,2},$LifetimeData[2,2,"All"],Length@*First],widthPhenotypesFull]}],Axes->False,AspectRatio->1/GoldenRatio,Frame->True,FrameStyle->Gray,FrameTicks->None]
Out[]=
In[]:=
Histogram[Values[$LifetimeData[2,2,"All"]]]
Out[]=