# Iterative loop for a given list

Suppose I have the following list:

l={{"a"}, {"a", "h"}, {"a", "d", "k", "r", "v"}, {"a", "b", "c",
"k"}, {"a", "b", "c", "s", "u"}, {"a", "b", "f", "t"}, {"a", "b",
"e", "l", "n", "o"}, {"a", "b", "d", "n", "o"}, {"a", "b", "d", "e",
"n", "o"}, {"a", "b", "d", "e", "m", "n", "o", "t"}, {"a", "b",
"e", "s"}, {"a", "b", "e", "m", "n", "s", "t"}, {"a", "b", "h",
"s"}, {"a", "b", "d", "e", "h", "s"}, {"a", "b", "e", "h", "m", "n",
"s", "t"}, {"a", "b", "e", "t"}, {"a", "b", "e", "m", "n",
"t"}, {"a", "b", "i", "o", "r", "t"}, {"a", "b", "e"}, {"a", "b",
"e", "s"}}


In the following command I take each element in the list above, find the subsets of it of size 2 and sort them by frequency, I then make a new list and replace the most frequent pair by a name as follow:

Tally[Flatten[Map[Subsets[#, {2}] &, Select[l, Length[#1] >= 1 &]],
1]];
Pairs = Sort[%, #1[[2]] < #2[[2]] &] // Reverse
l1 = l //. {OrderlessPatternSequence[Pairs[[1, 1, 1]],
Pairs[[1, 1, 2]], p___]} :> {Pairs[[1, 1]] // Capitalize //
StringJoin, p}


I want to do the same 20 times, each time the operation Tally and Pairs shall produce a new list, so for example the next list would form as:

 Tally[Flatten[Map[Subsets[#, {2}] &, Select[l1, Length[#1] >= 1 &]],
1]];
Pairs = Sort[%, #1[[2]] < #2[[2]] &] // Reverse
l2 = l1 //. {OrderlessPatternSequence[Pairs[[1, 1, 1]],
Pairs[[1, 1, 2]], p___]} :> {Pairs[[1, 1]] // Capitalize //
StringJoin, p}


and so on. How one does this using do/for/function?

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

Nest[replace, l, 4]


{{"a"}, {"a", "h"}, {"a", "d", "k", "r", "v"}, {"AB", "c", "k"}, {"AB", "c", "s", "u"}, {"AB", "f", "t"}, {"ABEN", "l", "o"}, {"AB", "d", "n", "o"}, {"ABEN", "d", "o"}, {"ABENM", "d", "o", "t"}, {"ABE", "s"}, {"ABENM", "s", "t"}, {"AB", "h", "s"}, {"ABE", "d", "h", "s"}, {"ABENM", "h", "s", "t"}, {"ABE", "t"}, {"ABENM", "t"}, {"AB", "i", "o", "r", "t"}, {"ABE"}, {"ABE", "s"}}

• Thank you for this answer, I went further yesterday to make a table from the nest part: I did n = 200; [Alpha] = Table[Nest[replace, GPr, i], {i, n}], problem is that the list I am using in reality (GPr) is of the length 56498 so when I run this it would take forever, I wonder how can I improve my method? Commented Aug 14, 2018 at 9:45
• @William, i don't know how to make it faster for large inputs.
– kglr
Commented Aug 14, 2018 at 22:23