As for refactoring, that in and of itself might be a challenge. One can avoid the memory grab but at the expense of a long iteration. I'd instead recommend changing the algorithm, so as to use powers of (1+t+t^2+t^3)
. Instead of repeating computations I would just keep the tally directly in the result.
getnumslist3[ll_] := Module[
{t, sslist, pairs},
sslist = ll[[All, 1]];
pairs = SplitBy[SortBy[Flatten[Table[
With[
{clist =
Reverse@CoefficientList[
Apply[Plus, t^{0, 1, 2, 3}]^sslist[[i]], t]},
MapIndexed[{#2[[1]] - 1, #1*ll[[i, 2]]} &, clist]],
{i, Length[sslist]}], 1], First], First];
Map[{#[[1, 1]], Total[#[[All, 2]]]} &, pairs]
]
Check that the result agrees with Tally
on the original for three iterations.
getnumslist3[f1]
(* Out[174]= {{0, 85}, {1, 342}, {2, 1038}, {3, 2631}, {4, 5575}, {5,
10458}, {6, 17656}, {7, 27010}, {8, 37930}, {9, 49128}, {10,
58873}, {11, 65545}, {12, 67861}, {13, 65370}, {14, 58618}, {15,
48858}, {16, 37785}, {17, 27051}, {18, 17850}, {19, 10803}, {20,
5958}, {21, 2964}, {22, 1314}, {23, 510}, {24, 168}, {25, 45}, {26,
9}, {27, 1}} *)
Now go one level further.
f = Nest[getnumslist3, {{1, 1}}, 4]
(* Out[191]= {{0, 621436}, {1, 7471332}, {2, 52618932}, {3,
279236466}, {4, 1222541634}, {5, 4631585400}, {6, 15630467652}, {7,
47900237346}, {8, 135130759246}, {9, 354505884069}, {10,
871618690157}, {11, 2020850395673}, {12, 4440188064925}, {13,
9283201253072}, {14, 18530962357622}, {15, 35419759585918}, {16,
64983058637123}, {17, 114675839863123}, {18, 195006335705772}, {19,
320048871959497}, {20, 507661915598537}, {21, 779202693545018}, {22,
1158531944606351}, {23, 1670155976457080}, {24,
2336467251666880}, {25, 3174214748838401}, {26,
4190539380488303}, {27, 5379108756793194}, {28,
6717029179946467}, {29, 8163250385673072}, {30,
9659073904440823}, {31, 11131120472464670}, {32,
12496733434607085}, {33, 13671357086181861}, {34,
14577019685433131}, {35, 15150763816905911}, {36,
15351776676473959}, {37, 15166114770549800}, {38,
14608274997888944}, {39, 13719370373306336}, {40,
12562221629904927}, {41, 11214162717002609}, {42,
9758682609222760}, {43, 8277131010514440}, {44,
6841595633218818}, {45, 5509756887730626}, {46,
4322119895369226}, {47, 3301604708579376}, {48,
2455125094483191}, {49, 1776559202824776}, {50,
1250432068840947}, {51, 855677138592297}, {52,
568984880918724}, {53, 367433373299856}, {54, 230282997223648}, {55,
139971096690798}, {56, 82444594000239}, {57, 47016461764467}, {58,
25934404994040}, {59, 13821926222520}, {60, 7108868470206}, {61,
3523582015788}, {62, 1680591108936}, {63, 770004663372}, {64,
338253440475}, {65, 142154088348}, {66, 57011216124}, {67,
21756929787}, {68, 7874531643}, {69, 2692456380}, {70,
865698255}, {71, 260302752}, {72, 72705528}, {73, 18707715}, {74,
4388040}, {75, 925515}, {76, 172341}, {77, 27612}, {78, 3663}, {79,
378}, {80, 27}, {81, 1}} *)
This can be plotted using e.g. ListPlot
or, if one prefers pictures like those from Histogram
, BarChart[f[[All, 2]], BarSpacing -> 0]
.