Let’s structure our data along the lines that WeightedData uses. Then we can use built-in features of WeightedData. Our initial generation looks like the following, where we list the individual genotypes first and the weights second.
InitGeneration={{"Dd"},{1}};
The following function helps us create offspring from a given pair of parent genotypes.
In[]:=
Offspring[a_,b_]:=StringJoin@*ReverseSort/@Tuples[{Characters[a],Characters[b]}]
In[]:=
Offspring["dD","Dd"]
Out[]=
{Dd,dd,DD,Dd}
Given some individuals and weights, we can pair them up and generate the associated weights. The nice thing is we can just generate all the pairs and the extract the EmpiricalPDF property from WeightedData.
In[]:=
WeightedPairings[{gens_,wts_}]:=WeightedData[ReverseSort/@Tuples[gens,2],Times@@@Tuples[wts,2]]["EmpiricalPDF"]
In[]:=
WeightedPairings[InitGeneration]
Out[]=
{{{Dd,Dd}},{1}}
In[]:=
WeightedPairings[{{"DD","Dd","dd"},{1/4,1/2,1/4}}]
Out[]=
{{dd,dd},{Dd,dd},{Dd,Dd},{DD,dd},{DD,Dd},{DD,DD}},,,,,,
1
16
1
4
1
4
1
8
1
4
1
16
Now let’s add a function that will compute the next generation for us. Again, we can leverage WeightedData.
In[]:=
NextGeneration[{gens_,wts_}]:=WeightedData[Flatten[Offspring@@@Tuples[gens,2]],Flatten[Outer[Times,Times@@@Tuples[wts,2],ConstantArray[1/4,4]]]]["EmpiricalPDF"]
In[]:=
NextGeneration[InitGeneration]
Out[]=
{DD,Dd,dd},,,
1
4
1
2
1
4
In[]:=
NextGeneration[NextGeneration[InitGeneration]]
Out[]=
{DD,Dd,dd},,,
13
64
19
32
13
64
Now we need a function to tell us whether an individual has the desired property.
In[]:=
SetAttributes[TallQ,Listable];TallQ[gen_]:=StringContainsQ[gen,"D"]
In[]:=
TallQ["Dd"]
Out[]=
True
In[]:=
TallQ[NextGeneration[InitGeneration][[1]]]
Out[]=
{True,True,False}
Let’s start generating some of your data for the table.
In[]:=
MapAt[MapApply[Divide[#,4]&@*Count[True]@*TallQ@*Offspring],WeightedPairings[{{"DD","Dd","dd"},{1/4,1/2,1/4}}],1]
Out[]=
0,,,1,1,1,,,,,,
1
2
3
4
1
16
1
4
1
4
1
8
1
4
1
16