use strict; use warnings; open my $inFH, q{<}, \ <<'END_OF_FILE' or die qq{open: $!\n}; peter piper picked a peck of pickled peppers a peck of pickled peppers peter piper picked if peter piper picked a peck of pickled peppers where's the peck of pickled peppers peter piper picked END_OF_FILE my $textFile = do { local $/; <$inFH>; }; close $inFH or die qq{close: $!\n}; my $rxWordPair = qr {(?x) ([\w'-]+) \W+ (?=([\w'-]+)) }; my %pairFrequencies; while ( $textFile =~ m{$rxWordPair}g ) { $pairFrequencies{ qq{$1 $2} } ++; } print map { qq{$_: $pairFrequencies{ $_ }\n} } sort { $pairFrequencies{$b} <=> $pairFrequencies{$a} || $a cmp $b } keys %pairFrequencies; #### of pickled: 4 peck of: 4 peter piper: 4 pickled peppers: 4 piper picked: 4 a peck: 3 peppers peter: 2 picked a: 2 if peter: 1 peppers a: 1 peppers where's: 1 picked if: 1 the peck: 1 where's the: 1