# Optimisation of a loop

I've opened a question here, which was answered. The code works totally fine for a small set of data. However, for a large set and over many iterations, it will take a long time (in order of 24 hours). Here I am going to provide a realistic example and the implementation of the code,

ELCo = Alphabet["English"];
Characters[ToLowerCase[WordList[Language -> "English"]]];
Select[%, SubsetQ[ELCo, ToLowerCase[#1]] &];
GPr = Map[Sort, Map[DeleteDuplicates, %]];


This code makes a list off all english words and separates them by letters and gets rid of duplicated characters. This list is called GPr and is all we need for the rest of the procedure. Now what I want is to find the commonest set of 2 and relabel it. For instance if {"a","b"} is the most common I replace it with "AB", indeed the following code goes through the list GPr and for each word, when there is a {"a","b"}combination, it does the relabelling:

ClearAll[replace]
replace =
With[{commonest =
Commonest[Flatten[Map[Subsets[#, {2}] &, #], 1]][[
1]]}, # //. {OrderlessPatternSequence[## & @@ commonest,
p___]} :> {StringJoin[ToUpperCase[commonest]], p}] &;


Next would be the result using:

n = 200;
x = Table[Nest[replace, GPr, i], {i, n}];


n is the number of time I want this procedure to be done. Basically every time it shall look at the previous list, take the most common pair and does the replacement. How shall I optimise the code to be able to run it for n=200 in a short period of time. Note that GPr has 39980 elements and it is large.

If you use NestList instead of Table & Nest, you can improve the speed from $\mathcal{O}(f(n))$ to $\mathcal{O}(\sqrt{f(n)})$.
On my laptop, this improves the runtime from ~30s to ~2.5s for $n=20$ and the first 1000 elements of GPr. (The estimated runtime for the full problem is around 10min):
n = 20;

The reason is simply that you don't need to recompute the first $i-1$ steps for the $i$th step.