Creating list of pairs of successive alliterating words?

Questions
1

I want to create a list of pairs of successive alliterating words, using Select.
I have this so far

Select[
 Partition[TextWords@[insert text here], 2, 1],
 StringTake[#, 1] == StringTake[#, 2] &
 ]

but it’s not working, I know the StringTake is wrong but I’m not sure how to fix it

2

text = “to to be or or not to be be”

Partition[TextWords@text, 2, 1] // Select[First@# == Last@# &]
(* {{"to", "to"}, {"or", "or"}, {"be", "be"}} *)
3

how do you think that could be adjusted for more than pairs of words?

4

Or, if you are a postfix fan like me

wordList // 
GatherBy[#, StringTake[ToLowerCase@#, 1] &] & // 
Map[Union] //
Select[Length@# > 2 &]
5

Crossposted here.

6

text = “Simply speaking: group word list into subsets with same first
character, eventually restricted to the CharacterRange, and select
from the Tally list the subset with count > 1”;text = “Simply speaking:
group word list into subsets with same first character,
eventually restricted to the CharacterRange,
and select from the Tally list the subset with count > 1”;

wordList = TextWords[text];  


allitteralQ[a_ , b_ ] :=  
SameQ @@ ((StringTake[#, 1] & ) /@ (ToLowerCase /@ {a, b}))

Select[Union /@ Gather[wordList, (allitteralQ[#1, #2] &)], (Length[#] > 1 &)]

All in One

Select[Union /@ Gather[ 
TextWords[text], 
Function[{a,b},  SameQ @@ ((StringTake[#, 1] & ) /@ (ToLowerCase /@ {a, b})) ]   ], 
(Length[#] > 1 &)]