# Iterative loop with many steps

I want to automate the following code, let me begin by explaining the code first. This code, for representation, is divided into 3 parts. The first is:

ELCo = Alphabet["English"];
Characters[ToLowerCase[WordList[Language -> "English"]]];
Select[%, SubsetQ[ELCo, ToLowerCase[#1]] &];
ELPr = Map[Sort, Map[DeleteDuplicates, %]];
ELP = Length[ELPr];
ELPrPo = Total[x^Map[Length, ELPr]];
ELM = Length[ELCo];


Where we take English words, make them into their characters and make two things from that ELPr which is the list of all characterised words and ELPrPo which is a polynomial that counts the words based on their size, so for example if you have $$142 x^2$$ it means there are 142 words of length 2 and so on. The next part of the code is,

Pairs = DeleteDuplicates[
Flatten[Table[Subsets[ELPr[[i]], {2}], {i, Length[ELPr]}], 1]];
\[Alpha] =
ParallelTable[LU = Select[ELPr, SubsetQ[#1, Pairs[[j]]] &];
LUer = Total[x^Map[Length, LU]];
LUerDelta = Expand[ELPrPo - LUer + LUer/x], {j, 1,
Length[Pairs]}];
\[Beta] = ParallelTable[c = i;
(27 - c)/
27 (Coefficient[\[Alpha], x, c]/Coefficient[ELPrPo, x, c]) //
N, {i, 1, 2}];
\[Gamma] = Transpose[{\[Beta][[1]], \[Beta][[2]]}];
PairsBoost = Reverse[Sort[Select[PairPerformance, Max[#1] > 1 &]]];
f1 = Table[
Transpose[{Sort[PairsBoost, #1[[i]] > #2[[i]] &] // Keys,
Sort[PairsBoost, #1[[i]] > #2[[i]] &] // Values}], {i, 2}];
f2 = f1[[2]][[All, 1]] // First


where Pairs is defined such that the code would go through words and make all the possible subsets of size two (thus pairs) and in fact one gets all the two character pairs possible in the ELPr list. $$\alpha$$ does some calculations on using ELPr and ELPrPo. Note that there is a 27 numeric in definition of $$\beta$$ that is number of english letters +1 and it would become important later. After the calculation the code throws f2 which is all we need, in this case

{"a", "l"}


now the last part of the code is,

g1 = ELPr //. {OrderlessPatternSequence["a", "l", p___]} :> {"a:l", p};
ELPrPo = Total[x^Map[Length, g1]];
Pairs = DeleteDuplicates[
Flatten[Table[Subsets[g1[[i]], {2}], {i, Length[g1]}], 1]];
\[Alpha] = ParallelTable[LU = Select[g1, SubsetQ[#1, Pairs[[j]]] &];
LUer = Total[x^Map[Length, LU]];
LUerDelta = Expand[ELPrPo - LUer + LUer/x], {j, 1,
Length[Pairs]}];
\[Beta] = ParallelTable[c = i;
(28 - c)/
28 (Coefficient[\[Alpha], x, c]/Coefficient[ELPrPo, x, c]) //
N, {i, 1, 2}];
\[Gamma] = Transpose[{\[Beta][[1]], \[Beta][[2]]}];

where we define g1 which goes through ELPr list and replace a and l where ever they come together with "a:l" now we have a new list so we need the new polynomial thus the next line would take g1 and make the polynomial and the rest of the calculations would be similar to part 2 of the code but based on g1 note that 28 number is 27+1 from part two. I wonder how this process can be automated to say do this for two iterations and get the values for f2 so after automatisation we get a following list:
{{"a", "l"},{"a:l", "e"},...}