Code

In[]:=
arFitness[ar_]:=Function[-Abs[Subtract[(Divide@@Dimensions[DeleteCases[#,{0...}]]),ar]]]
In[]:=
MarkovRuleMap[gensIndex_]:=Block[{​​gensRuleMap,ruleGensMap,​​size,ruleIndex​​},​​gensRuleMap=AssociationMap[GenRulesSymmetric[{2,2},#]&,Keys[gensIndex]];​​ruleGensMap=Association@Catenate@KeyValueMap[{g,rs}|->#->Lookup[gensIndex,Key[g]]&/@rs,gensRuleMap];​​​​{gensRuleMap,ruleGensMap}​​]
In[]:=
FitnessMarkovWeights[fitness_Function]:=Block[{​​ltdata=$LifetimeData[2,2,"Symmetric"],​​vertex,evolutionGraph,evolutionEdges,​​gensIndex,ruleGensMap,​​size,ruleIndex,evolutionEdgesIndex​​},​​evolutionGraph=EvolutionaryMultiwayGraph[​​changeFitness[{2,2},ltdata,fitness],​​"Reduced"->False,​​GraphLayout->"LayeredDigraphEmbedding",​​"DistanceFunction"->BinaryMutationDistance,​​AspectRatio->1];​​vertex=SelectFirst[VertexList[evolutionGraph],MemberQ[{0,65815}]];​​evolutionGraph=VertexOutComponentGraph[evolutionGraph,vertex];​​evolutionEdges=GroupBy[Join[​​Flatten[Map[Outer[Rule,#,#,1]&,​​VertexList[evolutionGraph]],2],​​Flatten[MapApply[Outer[Rule,#1,#2,1]&,​​EdgeList[evolutionGraph]],2]],First->Last];​​​​gensIndex=First/@PositionIndex[Keys[ltdata]];​​ruleGensMap=MarkovRuleMap[gensIndex][[2]];​​size=Length[ruleGensMap];​​ruleIndex=AssociationThread[Keys[ruleGensMap],Range[size]];​​​​evolutionEdgesIndex=Lookup[gensIndex,#]&/@KeyMap[gensIndex]@evolutionEdges;​​​​SparseArray[Map[rule|->With[{​​idx=Lookup[evolutionEdgesIndex,ruleGensMap[rule]],​​mutations=RuleMutationsList[{rule,2,2},"Symmetric"->True][[All,1]]​​},​​SparseArray[​​With[​​{allowedMutations=Lookup[ruleIndex,Select[mutations,MemberQ[idx,ruleGensMap[#]]&]]},​​Append[Lookup[ruleIndex,rule]->Length[mutations]-Length[allowedMutations]]@Thread[allowedMutations->1]​​]​​,​​size​​]​​],​​Keys[ruleIndex]​​]]​​]
In[]:=
FitnessMarkovWeights[None]:=Block[{​​ltdata=$LifetimeData[2,2,"Symmetric"],​​gensIndex,ruleGensMap,​​size,ruleIndex​​},​​​​gensIndex=First/@PositionIndex[Keys[ltdata]];​​ruleGensMap=MarkovRuleMap[gensIndex][[2]];​​size=Length@Keys[ruleGensMap];​​ruleIndex=AssociationThread[Keys[ruleGensMap],Range[size]];​​​​SparseArray[Map[rule|->With[{​​mutations=RuleMutationsList[{rule,2,2},"Symmetric"->True][[All,1]]​​},​​SparseArray[​​Thread[Lookup[ruleIndex,mutations,Lookup[ruleIndex,rule]]->1]​​,​​size​​]​​],​​Keys[ruleIndex]​​]]​​]
In[]:=
rawMarkovWeights=FitnessMarkovWeights[None];
In[]:=
arMarkovWeights=Parallelize@AssociationMap[FitnessMarkovWeights[arFitness[#]]&,{1,7,8,9,1,11,12}/10];
In[]:=
AppendTo[arMarkovWeights,None->rawMarkovWeights];
In[]:=
DuplicateFreeQ@arMarkovWeights
Out[]=
True
In[]:=
arMarkovData=ParallelMap[​​With[{matrix=N[#/Total/@#]},NestList[#.matrix&,UnitVector[Length[matrix],1],2500]​​]&,​​arMarkovWeights​​];
In[]:=
arMarkovData[[1]]//Dimensions
Out[]=
{2501,77624}
In[]:=
(*AppendTo[arMarkovData,{7/10,None}->With[{matrix=N[#/Total/@#]&@rawMarkovWeights},NestList[#.matrix&,arMarkovData[7/10][[-1]],2500]]];*)
In[]:=
(*AppendTo[arMarkovData,{7/10,"Random"}->With[{matrix=N[#/Total/@#]&@arMarkovWeights[7/10]},NestList[#.matrix&,Normalize[RandomReal[1,77624],Total],2500]]];*)
In[]:=
gens=Keys[$LifetimeData[2,2,"Symmetric"]];
In[]:=
gensCallouts=quickDepict[{2,2},#,$LifetimeData[2,2,"Symmetric"][#]]&/@gens;
In[]:=
{gensRuleMap,ruleGensMap}=MarkovRuleMap[First/@PositionIndex[gens]];
In[]:=
size=Length[ruleGensMap];
In[]:=
ruleIndex=AssociationThread[Keys[ruleGensMap],Range[size]];
In[]:=
gensRuleIndices=Lookup[gensRuleMap,Key@#]&/@gens;
In[]:=
arPhenotypeData=Map[(x|->Total/@x[[All,Lookup[ruleIndex,#]]]&/@gensRuleIndices),arMarkovData];
In[]:=
Dimensions/@arPhenotypeData
Out[]=

1
10
{77,2501},
7
10
{77,2501},
4
5
{77,2501},
9
10
{77,2501},
11
10
{77,2501},
6
5
{77,2501},None{77,2501}

Width case

In[]:=
FitnessMarkovWeights[Function[Length[First[#]]]]
Out[]=
SparseArray
Specified elements: 1272600
Dimensions: {77624,77624}
Data not saved. Save now

In[]:=
widMatrix=N
Total/@
;
In[]:=
lftdata=KeyMap[First,$LifetimeData[2,2,"Symmetric"]];​​dataCallouts=quickDepict[{2,2},{#,0},lftdata[#]]&/@VertexList[evolutionGraph][[All,1,1]];
In[]:=
data=Map[(x|->Total@x[[Lookup[ruleIndex,#]]]&/@gensRuleIndices),NestList[#.widMatrix&,UnitVector[Length[widMatrix],1],1500]];
In[]:=
ByteCount[data]
Out[]=
4782384
In[]:=
ListLinePlot[MapThread[Which[Last[#1]>.05,Callout[#1,#2],Max[#1]>0.4,Callout[#1,#2,{300,.8},50],Max[#1]>0.2,Callout[#1,#2,400,250],0.15>Max[#1]>.11,Callout[#1,#2,Scaled[.2],2000],.02<Max[#1]<=.11,#1,True,Nothing]&,{Transpose@data,gensCallouts}],PlotRange->Full,Frame->True,ImageSize->Medium,ImagePadding->{{Automatic,100},{10,0}}]