1
$\begingroup$

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?

$\endgroup$
1
$\begingroup$
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"}}

$\endgroup$
  • $\begingroup$ 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? $\endgroup$ – William Aug 14 '18 at 9:45
  • $\begingroup$ @William, i don't know how to make it faster for large inputs. $\endgroup$ – kglr Aug 14 '18 at 22:23

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.