#!/usr/bin/perl
use strict; use warnings; # 75O0K8S - Benchmark all the Trigram-finders!
use Benchmark   qw(cmpthese                  ); # with liberty taken to
use Text::Ngram qw(ngram_counts add_to_counts); # reformat aggressively
my   @strs =    qw(computer CheesyNachoz JustAnotherPerlHacker);my $str;
push(@strs, 'Just Another Perl Hacker'); # add a test string w/ spaces too
my   %cnms = ( # CodeRefName => PerlMonkAuthor (in post order)
    'whileZ'   =>                   'Zaxo'          ,
    'recurseO' =>                   'otto'          ,
    # not sure how to do magic       blazar goto Tail-Recursion
    'whileM'   =>                   'Marknel'       ,
    'mapB'     =>                   'blazar'        ,
    'hngramG'  =>                   'graff'         ,
    'substrGF' =>                   'GrandFather'   ,
    'unpackLG' =>  'Limbic~Region && GrandFather'   ,
    'regexGF'  =>                   'GrandFather'   ,
    'mapstrS'  =>                   'Skeeve'        ,
    'substrS'  =>                   'Skeeve'        ,
    'regexS'   =>                   'Skeeve'        ,
    'counmapA' =>                   'andreas1234567',
    'mapstrS2' =>                   'Skeeve'        ,
    'whileAB'  => 'Anonymous Monk && blazar'        ,
    'hmapB'    =>                   'blazar'        ,
    'regexS2'  =>                   'Skeeve'        ,
    'whileP'   =>                   'Pip'           ,
    'regexP'   =>                   'Pip'           ,
); my $crfs; $crfs->{$_} = \&{"do_$_"} for(keys(%cnms));
for my $strn (@strs) { $str = $strn; # assign global $str for all subs
  for my $cnam (sort { $a cmp $b } keys(%{$crfs})) {
    printf("%-8s:%s\n", $cnam, join ' ', $crfs->{$cnam}->());
  } cmpthese(-1, $crfs);
}
sub do_whileZ   { local $_ = $str; my @tris;
  pos() -= 2, push @tris, $1  while /(...)/g;              return @tris; }
sub recurse     { my($cnt, $ra_out, $ra_val, $ra_in)= @_;
  if(  $#$ra_val !=  $cnt) { # working array not full
    if($#$ra_in  >     -1) { # fill it up
      push(@$ra_val, shift(@$ra_in));
      recurse($cnt, $ra_out, $ra_val, $ra_in);
    } else { return; }       # done with list
  } else {
    # add to output array, joined ltr string, rip off first ltr
    push(@$ra_out, join('',@$ra_val)); shift(@$ra_val);
    # add new ltr, if any remaining
    push(@$ra_val, shift(@$ra_in)) if($#$ra_in > -1);
    recurse($cnt, $ra_out, $ra_val, $ra_in);
  }
} # input letter array, output trigram string array, && values workspace
sub do_recurseO { my @in = split('', $str); my @tris; my @val;
  recurse( 2, \@tris, \@val, \@in );                       return @tris; }
sub do_whileM   { my $strlen = length($str); my $loop_num = $strlen-2;
  my   @tris;     my $ndx = 0;  while($ndx <    $loop_num){
    my $tri = substr $str,$ndx,3; push @tris,$tri;$ndx++; }return @tris; }
sub do_mapB     { my @tris = map { substr $str, $_, 3 } 0..length($str)-3;
                                                           return @tris; }
sub do_hngramG  { my $href = ngram_counts($str, 3);
                                 return sort { $a cmp $b } keys %{$href};}
sub do_substrGF { my @tris;
  push @tris, substr $str, $_, 3 for 0..length($str)-3;    return @tris; }
# HTTP://Perl.Com/doc/manual/html/pod/perlfunc/unpack.html
sub do_unpackLG { my $mats = length($str)-2;  my $tmpl = 'a3XX' x $mats;
    my @tris = unpack($tmpl, $str);                        return @tris; }
sub do_regexGF  { my @tris = $str =~ /(?=(...))/g;         return @tris; }
sub do_mapstrS  {       return map substr($str,$_-3,3),(3..length $str); }
sub do_substrS  { my @tris;
  push @tris, substr $str, $_, 3 for 0..length($str)-3;    return @tris; }
sub do_regexS   {                           return $str =~ /(?=(...))/g; }
sub do_counmapA { return map { (length($_)-2) } split('\s+', $str);      }
sub do_mapstrS2 { my $len = 3; my @tris = map substr($str,$_-$len,$len),
  ($len..length $str);                                     return @tris; }
sub do_whileAB  { my @tris; my $stri = $str; while($stri) {
  $stri =~ /(...)/ and push @tris, $1; $stri =~ s/^.//;   }return @tris; }
sub do_hmapB    { my %saw; my @tris = map { my $s = substr $str, $_, 3;
  $saw{$s}++ ? () : $s } 0..length($str)-3;return sort{$a cmp$b}keys%saw;}
sub do_regexS2  { $_ = $str; s/(.)(.)(.)(?=(.)(.))/$1$2$3$2$3$4$3$4$5/g;
                                                        return /(...)/g; }
sub do_whileP   { my @tris; $_ = $str; # s/// is slow!
  push @tris, $1 while(s/^(.(..))/$2/);                    return @tris; }
sub do_regexP   { $_ = $str; s/((?:.)((?:.)(.)))(?=(.)(.))/$1$2$4$3$4$5/g;
                                                        return /(...)/g; }