use strict;
use warnings;

use Benchmark qw( cmpthese );


# Use constant to provide comparable results.
use constant GROUP_LENGTH => 3;


# Generate a random string all tests will use.
my $seq = join '',
          map { (qw[ A C G T ])[rand(4)] }
          1..600_000;


# ---


sub sauoq {
   my %count;

   my $length = length $seq;
   for my $i (0..$length-1) {
      ++$count{substr($seq, $i, 1)};
      ++$count{substr($seq, $i, 2)} if $i < $length - 1;
      ++$count{substr($seq, $i, 3)} if $i < $length - 2;
   }

   return \%count;
}


sub sauoq_i {
   my %count;

   my $length = length($seq);
   for my $i (0..$length-3) {
      ++$count{substr($seq, $i, 1)};
      ++$count{substr($seq, $i, 2)};
      ++$count{substr($seq, $i, 3)};
   }

   ++$count{substr($seq, -2, 2)};
   ++$count{substr($seq, -2, 1)};
   ++$count{substr($seq, -1, 1)};

   return \%count;
}


sub limbic {
   my %count;
   my $template = ('AXA2X2A3X2' x (length($seq) - 2)) . 'AXA2XA';
   ++$count{$_} foreach unpack $template, $seq;
   return \%count;
}


sub injun {
   my %count;

   my @bases = split //, $seq;

   for my $i (0..$#bases) {
      ++$count{$bases[$i]                          };
      ++$count{$bases[$i].$bases[$i+1]             } if defined $bases
+[$i+1];
      ++$count{$bases[$i].$bases[$i+1].$bases[$i+2]} if defined $bases
+[$i+2];
   }

   return \%count;
}


sub ikegami {
   my %count;
   ++$count{$1} while $seq =~ /(?=(.))/g;
   ++$count{$1} while $seq =~ /(?=(..))/g;
   ++$count{$1} while $seq =~ /(?=(...))/g;
   return \%count;
}


sub skeeve2 {
   my %count;

   for my $i (0..length($seq)-GROUP_LENGTH()) {
      ++$count{substr($seq, $i, GROUP_LENGTH)};
   }

   my @keys = keys %count;
   foreach my $key (@keys) {
      for my $i (1..GROUP_LENGTH-1) {
         $count{substr($key, 0, $i)} += $count{$key};
      }
   }

   for my $i (1..GROUP_LENGTH-1) {
      for my $j ($i..GROUP_LENGTH-1) {
         ++$count{substr($seq, -$j, $i)};
      }
   }

   return \%count;
}


sub skeeve3 {
   my %count;

   ++$count{"$1$2"} while $seq =~ /(.)(?=(..))/g;

   my @keys = keys %count;
   foreach my $key (@keys) {
      $count{substr($key, 0, 1)} += $count{$key};
      $count{substr($key, 0, 2)} += $count{$key};
   }

   ++$count{substr($seq, -2, 2)};
   ++$count{substr($seq, -2, 1)};
   ++$count{substr($seq, -1, 1)};

   return \%count;
}


sub skeeve3_i {
   my %count;

   $count{$1}++ while $seq =~ /(?=(...))/g;

   my @keys = keys %count;
   foreach my $key (@keys) {
      $count{substr($key, 0, 1)} += $count{$key};
      $count{substr($key, 0, 2)} += $count{$key};
   }

   ++$count{substr($seq, -2, 2)};
   ++$count{substr($seq, -2, 1)};
   ++$count{substr($seq, -1, 1)};

   return \%count;
}


sub radiant {
   my %count;

   my @rolling;
   $#rolling = 2;

   for my $i (0..length($seq)-1) {
      my $char = substr($seq, $i, 1);

      shift @rolling;
      push @rolling, $char;

      $count{$rolling[2]}++;            #one-char count

      next if not defined $rolling[1];
      $count{join('',@rolling[1,2])}++; #two-char count

      next if not defined $rolling[0]; 
      $count{join('',@rolling)}++;      #three-char count
   }

   return \%count;
}


sub radiant_i {
   my %count;

   my @rolling;
   $#rolling = 2;

   for my $i (0..length($seq)-1) {
      my $char = substr($seq, $i, 1);

      shift @rolling;
      push @rolling, $char;

      next if $i < 2;
      $count{join('', @rolling)}++;
   }

   my @keys = keys %count;
   foreach my $key (@keys) {
      $count{substr($key, 0, 1)} += $count{$key};
      $count{substr($key, 0, 2)} += $count{$key};
   }

   ++$count{substr($seq, -2, 2)};
   ++$count{substr($seq, -2, 1)};
   ++$count{substr($seq, -1, 1)};

   return \%count;
}


# ---


sub hash_count {
   my ($count) = @_;

   my $total = 0;
   $total += $_ foreach values %$count;

   return join ',',
          "total=>$total", 
          map { sprintf("%s=>%s", $_, $count->{$_}) }
          sort { length($a) <=> length($b) || $a cmp $b }
          keys %$count;
}


my @tests = qw(
   sauoq
   sauoq_i
   limbic
   injun
   ikegami
   skeeve2
   skeeve3
   skeeve3_i
   radiant
   radiant_i
);


{
   my $ok = 1;

   my @results = map { hash_count((\&$_)->()) } @tests;

   for my $i (0..$#tests) {
      for my $j (0..$#tests) {                # or start at $i+1
         if ($results[$i] ne $results[$j]) {
            $ok = 0;
            print("$tests[$j] differs from $tests[$i].\n");
         }
      }
   }

   if ($ok) {
      print("No differences encountered.\n");
      print("\n");
   } else {
      print("\n");
      print("Differences encountered.\n");
      print("\$seq: $seq\n");
      print("$tests[$_]: $results[$_]\n") for (0..$#tests);
      die("\n");
   }
}


cmpthese(5, { map { $_ => \&$_ } @tests });
[download]