I have the list:

l = 
  {{"d", "w", "x"}, {"a", "d"}, {"e", "h", "u", "d", "c", "q"}, 
   {"e", "c", "e", "a", "d", "e"}, {"s", "x", "r", "t", "v", "f"}, {"s"}, 
   {"c", "d", "e"}, {"s", "t", "y", "m"}, {"t", "d", "t", "u", "i", "q"}};

I want to select those elements that they are of length 6, so I evaluate

sizedl = Select[l, Length@# == 6 &]

and get

{{"e", "h", "u", "d", "c", "q"}, {"e", "c", "e", "a", "d", "e"}, 
 {"s","x", "r", "t", "v", "f"}, {"t", "d", "t", "u", "i", "q"}}

I next want to find the most common characters, pair them and capitalise them. I have the following function to do that.

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

Alpha = NestList[replace, sizedl, 1]

The second part of Alpha gives:

{{"ED", "c", "h", "q", "u"}, {"ED", "a", "c", "e", "e"}, 
 {"s", "x", "r", "t", "v", "f"}, {"t", "d", "t", "u", "i", "q"}} 

Now, in this new list I have two elements of 5 and two elements of size 6. I want to get rid of the ones that are size 5 and repeat the same procedure.

sizedl1 = Select[Alpha[[2]], Length @ # == 6 &];
Alpha = NestList[replace, sizedl1, 1];

I wonder how can I do this procedure for t times without repeating the code as above.

Clarification: The output for t=3 should look like this:

l = {{"d", "w", "x"}, {"a", "d"}, {"e", "h", "u", "d", "c", 
"q"}, {"e", "c", "e", "a", "d", "e"}, {"s", "x", "r", "t", "v", 
"f"}, {"s"}, {"c", "d", "e"}, {"s", "t", "y", "m"}, {"t", "d", 
"t", "u", "i", "q"}};

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

sized1 = Select[l, Length@# == 6 &];
a1 = NestList[replace, sizedl, m][[2]]

sized2 = Select[a1, Length@# == 6 &];
a2 = NestList[replace, sized2, m][[2]]

sized3 = Select[a2, Length@# == 6 &];
a3 = NestList[replace, sized3, m][[2]]


{{"ED", "c", "h", "q", "u"}, {"ED", "a", "c", "e", "e"}, {"s", "x", 
  "r", "t", "v", "f"}, {"t", "d", "t", "u", "i", "q"}}

{{"s", "x", "r", "t", "v", "f"}, {"TU", "d", "i", "q", "t"}}

{{"SX", "f", "r", "t", "v"}}
  • $\begingroup$ what is "replace" in your code? $\endgroup$
    – ZaMoC
    Commented Oct 15, 2018 at 13:21
  • $\begingroup$ Thank for the notice, I corrected it. replace it the function that does the replacement. $\endgroup$
    – Wiliam
    Commented Oct 15, 2018 at 13:23
  • $\begingroup$ what about p and k in the replace function? $\endgroup$
    – ZaMoC
    Commented Oct 15, 2018 at 13:38
  • $\begingroup$ k is a number which indicates pairs and is equal to 2. Fixed it. and p is variable that indicates what shall be capitalised. $\endgroup$
    – Wiliam
    Commented Oct 15, 2018 at 13:40
  • $\begingroup$ for the sake of example lets us take t=2. But in general I am dealing with a list that has 56000 elements and I want to apply the method for arbitrary t. $\endgroup$
    – Wiliam
    Commented Oct 15, 2018 at 13:51

1 Answer 1

replaceselect = Composition[replace, Select[Length @ # == 6 &]];
Rest @ NestWhileList[replaceselect , l, Length@# > 1 &]

{{{"ED", "c", "h", "q", "u"}, {"ED", "a", "c",    "e", "e"}, {"s", "x", "r", "t", "v", "f"}, {"t", "d", "t", "u", "i", "q"}},
{{"s", "x", "r", "t", "v", "f"}, {"TU", "d", "i", "q",    "t"}},
{{"SX", "f", "r", "t", "v"}}}

  • $\begingroup$ Such short and neat answer deserves a wow. I learnt a lot from you so far @kglr $\endgroup$
    – Wiliam
    Commented Oct 15, 2018 at 15:34
  • 1
    $\begingroup$ Thank you for the accept and kind words @William. $\endgroup$
    – kglr
    Commented Oct 15, 2018 at 15:36

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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