one perl contiguous subsequences benchmark run and code

benchmark-subseqs.pl

#!/usr/bin/env perl
use strict;
use warnings;

use Benchmark qw(timethese);
use List::Util qw(all);

my $count = shift || 100_000_000;

my $mother = [qw(qn qn qn)];
my $father = [qw(qn qn qn qn)];

timethese($count, {
    ology => sub { contiguous_subsequences($mother, $father) },
    tirnanog => sub { tirnanog($mother, $father) },
    botje => sub { botje($mother, $father) },
});

sub ology {
    my ($little_set, $big_set) = @_;
    my $little_set_size = @$little_set;
    my $big_set_size    = @$big_set;
    my @matches;
    my $i = 0; # little set index
    my $j = 0; # big set index
    my $k = 0; # matches found
    my $p = 0; # initial big set position
    my $f = 0; # failed to find match
    while ($i < $little_set_size && $j < $big_set_size) {
        if ($little_set->[$i] eq $big_set->[$j]) {
            $k++;   # We match
            $j++;   # Move to the next element in the big_set
            $f = 0; # failed to find match
        }
        else {
            $f++;
        }
        $i++;  # Move to the next element in the little_set
        if ($f || $i >= $little_set_size) {
            push @matches, $p if $k == $little_set_size;
            $p++;    # increment the big set position
            $i = 0;  # reset the little set position
            $j = $p; # set the big set index to the big set position
            $k = 0;  # no matches seen
        }
    }
    return \@matches;
}

sub tirnanog {
    my ($needles, $haystack) = @_;
    my @indices;
    my $length = $needles->@*;
    if ($length > 0 && $haystack->@* >= $length) {
        my $i = 0;
        my $j = $haystack->@* - $length;
        while ($i <= $j) {
            if ($length == grep { $needles->[$_] eq $haystack->[$i + $_] } keys $needles->@*) {
                push @indices, $i;
            }
            ++$i;
        }
    }
    return \@indices;
}

sub botje {
    my ($needles, $haystack) = @_;
    return () unless $needles->@*;
    my @results = grep {
        my $i = $_;
        $needles->@* == grep { $needles->[$_] eq $haystack->[$i + $_] } keys $needles->@*;
    } 0 .. $haystack->$#* - $needles->$#*;
    return \@results;
}

output.txt

Benchmark: timing 100000000 iterations of x, y, z...
         ology: 135 wallclock secs (134.81 usr +  0.03 sys = 134.84 CPU) @ 741619.70/s (n=100000000)
         tirnanog: 84 wallclock secs (83.55 usr +  0.02 sys = 83.57 CPU) @ 1196601.65/s (n=100000000)
         Botje: 93 wallclock secs (92.89 usr +  0.01 sys = 92.90 CPU) @ 1076426.26/s (n=100000000)