Just out of curiosity, I wrote a stochastic simulation. I start with a few surnames, give them a random frequency, and build a starting population with those surnames with the given frequencies. The new generation is generated this way: first I make a random permutation of the previous population, then I take half of the remixed population, and finally I redouble this half: this simulates married couples that homogenize their surnames:
Clear[initialFrequencies, startingPopulation, population];
surnames = {"Sato", "Suzuki", "Takahashi",
"Tanaka", "Watanabe", "Ito"};
initialFrequencies =
1000*(Join[{0, 1}, RandomReal[{0, 1}, Length[surnames] - 1]] //
Sort // Differences) // Sort // Reverse // Round;
startingPopulation =
Thread[Inactive[ConstantArray][surnames, initialFrequencies]] //
Activate // Flatten;
population[0] = startingPopulation;
population[n_] :=
population[n] = Module[{randomHalfPopulation}, randomHalfPopulation =
RandomSample[population[n - 1]][[1 ;; -1 ;; 2]];
Join[randomHalfPopulation, randomHalfPopulation]];
ListLinePlot[
Transpose[
surnames /. Table[Association @@ (Rule @@@ Tally[population[n]]),
{n, 0, 30}]],
PlotLegends -> surnames]
Running the simulation a few times does not show a clear pattern. Sometimes Sato increases, sometimes it decreases. The least frequent surnames are at risk of extinction.
