# Converting a free variable in a pure function into a parameter that can be varied under iteration

Here I am going, as a matter of illustration, make a large string list:

l = Characters[WordList[]];
l = Table[DeleteDuplicates[l[[i]]], {i, Length[l]}];


This list would give all English words disjointed by letters. Now I want have a function that takes most frequent letter and join them into capital letter. k is the symbol for that for example k=2 takes two most frequent letters, k=3 takes 3 most frequent letters and so on.

Now I want to select from l those elements that are size 8, once with k=2 in the next step I want to look at the second part of the new list and make k=3 and so on. Here is what I did:

k = 2;
ClearAll[replace]
replace =
With[{commonest =
Commonest[Flatten[Map[Subsets[#, {k}] &, #], 1]][[
1]]}, # //. {OrderlessPatternSequence[## & @@ commonest,
p___]} :> {StringJoin[ToUpperCase[commonest]], p}] &;
a1 = NestList[replace, Select[l, Length@# == 8 &], 1];
k = 3;
ClearAll[replace]
replace =
With[{commonest =
Commonest[
Flatten[Map[Subsets[#, {k}] &, #],
1]][[1]]}, # //. {OrderlessPatternSequence[## & @@ commonest,
p___]} :> {StringJoin[ToUpperCase[commonest]], p}] &;
a2 = NestList[replace, Select[a1[[2]], Length@# == 8 &], 1];
k = 4;
ClearAll[replace]
replace =
With[{commonest =
Commonest[
Flatten[Map[Subsets[#, {k}] &, #],
1]][[1]]}, # //. {OrderlessPatternSequence[## & @@ commonest,
p___]} :> {StringJoin[ToUpperCase[commonest]], p}] &;
a3 = NestList[replace, Select[a2[[2]], Length@# == 8 &], 1];


I wonder how can I do this operation meaning make a1, a2 and a3 lists without re-writting the replace function every time. As you can see a1 looks at l, and a2 looks at a1 and so on (in a1 = NestList[replace, Select[l, Length@# == 8 &], 1])

You can do it by defining replace as function that returns a replacer based on k and using FoldList in place of Nest.

But first I advise speeding things up by preprocessing the data.

data =
Select[DeleteDuplicates /@ Characters[WordList[]], Length @ # == 8 &] //
DeleteDuplicates;


This reduces the number characters processed down to 52416 from the 274098 in your list l.

Now here how is it works with FoldList and a parameratized replace.

replace[k_] :=
With[{commonest = Commonest[Flatten[Map[Subsets[#, {k}] &, #], 1]][[1]]},
# //. {OrderlessPatternSequence[## & @@ commonest, p___]} :>
{StringJoin[ToUpperCase[commonest]], p}] &;
k = 3; u = FoldList[replace[#2][#1] &, data, Range[2, k]];
Row[Column /@ u[[All, ;; 12]]]


The variable u is of course bound to the full results, but to keep this answer down to a reasonable length, I have chosen to show only the 1st 12 items in each sublist of the full output.

You can create a function f that generates your function like this:

f = k \[Function]
With[{commonest =
Commonest[
Flatten[Map[Subsets[#, {k}] &, #],
1]][[1]]}, # //. {OrderlessPatternSequence[## & @@
commonest, p___]} :> {StringJoin[ToUpperCase[commonest]],
p}] &;


And then

a1 = NestList[f[2], Select[l, Length@# == 8 &], 1];
a2 = NestList[f[3], Select[a1[[2]], Length@# == 8 &], 1];
a3 = NestList[f[4], Select[a2[[2]], Length@# == 8 &], 1];