2
$\begingroup$

Taking a list of words, I'd like to pick out consecutive words that start with the same letter. The output should be a list of these pairs.

The following is relatively slow:

WikipediaData["alliteration"] // 
TextWords // 
FixedPoint[
  Replace[
    #, 
    {{s___List, w_String, x_String, r___} /; StringTake[w, 1] == StringTake[x, 1] :> 
       {s, {w, x}, x, r}, 
     {s___List, w_String, x_String, r___} :> {s, x, r}, 
     {s___List, w_String} :> {s}}] &, #] &

This one is significantly faster:

WikipediaData["alliteration"] // 
TextWords // 
Partition[#, 2, 1] & //
Select[#, StringTake[First[#], 1] == StringTake[Last[#], 1] &] &
$\endgroup$
8
  • $\begingroup$ How about SequenceCases[TextWords[WikipediaData["alliteration"]], {s1_, s2_} /; StringStartsQ[s2, StringTake[s1, 1]]]? $\endgroup$
    – J. M.'s torpor
    May 18 '16 at 15:23
  • $\begingroup$ Works, but it doesn't seem particularly efficient - on my system it took over 28.25s, while the methods I showed took 18.98s and 0.125s, respectively. I'm actually curious as to why your method takes so long. $\endgroup$
    – Adrian
    May 18 '16 at 15:30
  • $\begingroup$ @Kuba, had forgotten to take care of that lone word - fixed $\endgroup$
    – Adrian
    May 18 '16 at 18:44
  • $\begingroup$ @Kuba, Sure, since would handle pairs too, but I'm still looking for performance. $\endgroup$
    – Adrian
    May 18 '16 at 18:47
  • $\begingroup$ @Adrian the question is about {"splendid", "silent", "sun"} and more. Your method drops sun completely. $\endgroup$
    – Kuba
    May 18 '16 at 18:52
5
$\begingroup$

Here's a simple version using SplitBy.

Select[SplitBy[words, StringTake[#, 1] &], Length@# > 1 &]

It groups words by the first letter, then picks groups larger than 1. So it solves the more general problem rather than strictly doing pairs.

I don't have no fancy WikipediaData on my version, but it seems faster using some randomly generated data.

$\endgroup$
2
  • $\begingroup$ Aargh, I was just going to answer myself with this. Oh well, in my answer I was going to provide a solution limiting the grouping to 2, as in the OP, so I suppose I can still put that up. $\endgroup$
    – Adrian
    May 18 '16 at 21:57
  • 2
    $\begingroup$ That's a great one! Never used SplitBy... And about twice faster than my monster $\endgroup$
    – BlacKow
    May 18 '16 at 22:11
4
$\begingroup$

I got faster result using listability of StringTake and Pick instead of Select

words = WikipediaData["alliteration"] // TextWords;
{a1, res} = 
  AbsoluteTiming[
   words // Partition[#, 2, 1] & // 
    Select[#, 
      StringTake[First[#], 1] == StringTake[Last[#], 1] &] &];
a1 (* 0.002902 *)

{b1, res} = 
  AbsoluteTiming[
   Pick[Partition[#, 2, 1] &@#, 
      Equal @@@ Partition[#, 2, 1] &@StringTake[#, 1] &@#, True] &@
    words];
b1 (* 0.001041 *)

Although it's not in OP's question, it would be nice to handle cases when same first letter words sequence is longer than two (e.g {"splendid", "silent", "sun"} as Kuba mentioned). Following code is way slower but handles any length of repeating first letter. It produces list of sublists where every sublist represents sequence of words with the same first letter. For this particular article from Wikipedia the longest sublist has 5 elements.

f[{x_, n_, id_}, y_] := If[x == y, {x, n + 1, id + 1}, {y, 1, id + 1}];
{t, sublists} = 
  AbsoluteTiming[
   words[[#[[1]] ;; #[[2]]]] & /@ Partition[#, 2] &@#[[All, 1, 2]] &@
              Select[#, (#[[1, 1]] == 1 && #[[2, 1]] > 1) || #[[1, 
                    1]] > #[[2, 1]] &] &@Partition[#, 2, 1] &@#[[All, 
            2 ;; -1]] &@FoldList[f, {#[[1]], 1, 1}, #[[2 ;; -1]]] &@
      StringTake[#, 1] &@words];
t
Select[#, Length@# > 2 &] &@sublists
(* 0.011589 *)
{{"furrow", "followed", "free"}, {"who", "watch", "with", "wild", 
  "wonder"}, {"beautiful", "birds", "begin"}, {"batter", "bitter", 
  "but"}, {"bitter", "batter", "better"}, {"Peter", "Piper", "Peter", 
  "Piper"}, {"Æthelwulf", "Æthelbald", "Æthelberht"}, {"splendid", 
  "silent", "sun"}, {"Splendid", "Silent", "Sun"}, {"as", "an", 
  "artistic"}, {"an", "audience\[CloseCurlyQuote]s", 
  "attention"}, {"them", "to", "the"}, {"twenty-one", "times", 
  "throughout"}, {"today", "that", "the"}, {"testimony", "to", "the"}}
$\endgroup$
5
  • $\begingroup$ Looks good - just need to understand what's happening there :-) $\endgroup$
    – Adrian
    May 18 '16 at 18:48
  • $\begingroup$ @Adrian It obtains the first letter only once per word, and your method does it twice. Also I'm feeding StringTake[#,1] with a list (since it's Listable) and you are iterating over partitioned list and applying StringTake to every element one at a time. $\endgroup$
    – BlacKow
    May 18 '16 at 18:51
  • $\begingroup$ That means, for the general case, my second version is still the one to beat. $\endgroup$
    – Adrian
    May 18 '16 at 20:29
  • $\begingroup$ @Adrian No. It does different thing. It doesn't return list of pairs. It returns list of sublists where every sublist represents a sequence of words having the same first letter. Some sublists have two elements (that's what you initially wanted), some have more. The longest sublist is {"who", "watch", "with", "wild", "wonder"}. So you can't compare these two methods, they are doing different things. $\endgroup$
    – BlacKow
    May 18 '16 at 20:34
  • $\begingroup$ Actually, what your second one does is different. So you get the crown back. $\endgroup$
    – Adrian
    May 18 '16 at 20:34
1
$\begingroup$

@wxffles beat me to a SplitBy solution, but his version doesn't return a result limited to pairs. So, if that's the requirement, here's one that does. This method is a bit slower for pair-wise collection compared to my second solution in the OP:

words = WikipediaData["alliteration"] // TextWords;
SplitBy[words, ToLowerCase[StringTake[#, 1]] &] // 
   Select[#, Length[#] > 1 &] & // 
  If[Length[#] > 2, Partition[#, 2, 1], #] & /@ # & // Level[#, {-2}] &

Additionally, most solutions, my own initial ones included, did not ignore case so they missed some groups. The ones provided here do so.

Like @wxffles ', but ignoring case:

SplitBy[words, ToLowerCase[StringTake[#, 1]] &] // 
 Select[#, Length[#] > 1 &] &
$\endgroup$
2
  • 1
    $\begingroup$ Why Identity[#] instead of #? $\endgroup$
    – BlacKow
    May 18 '16 at 23:59
  • $\begingroup$ Oversight - I'll remove. $\endgroup$
    – Adrian
    May 19 '16 at 0:05

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.