#!/usr/bin/perl
use warnings;
use strict;
use Benchmark qw(cmpthese timethese);
my @test = ([ qw(fooabc123 fooabc321 foobca232) ],
[ qw(abcfoo123 bcafoo321 foo123abc) ],
[ qw(foo bor boz bzo) ]);
for (@test) {
die "regex,index" unless lcs_regex(@{$_}) eq lcs_index(@{$_});
die "index,buk" unless lcs_index(@{$_}) eq lcs_buk(@{$_});
}
my $result = timethese(-5, {
'regex' => sub { lcs_regex(@{$_}) for @test },
'index' => sub { lcs_index(@{$_}) for @test },
'buk' => sub { lcs_buk(@{$_}) for @test },
});
cmpthese $result;
sub lcs_regex {
my $substr = $_[0];
my $len = length $_[0];
my $off = 0;
while ($substr) {
my @matches = grep /\Q$substr/, @_;
#printf "%s%-".(length($_[0])-$off)."s matches %d\n",
# " " x $off, $substr, scalar @matches;
last if @matches == @_;
$off++;
$len-- and $off=0 if $off+$len > length $_[0];
$substr = substr $_[0], $off, $len;
}
return $substr;
}
sub lcs_index {
my $substr = $_[0];
my $len = length $_[0];
my $off = 0;
while ($substr) {
my @matches = grep { -1 != index $_, $substr } @_;
#printf "%s%-".(length($_[0])-$off)."s matches %d\n",
# " " x $off, $substr, scalar @matches;
last if @matches == @_;
$off++;
$len-- and $off=0 if $off+$len > length $_[0];
$substr = substr $_[0], $off, $len;
}
return $substr;
}
sub lcs_buk {
my $strings = join "\0", @_;
my $lcs;
for my $n ( 1 .. length $strings ) {
my $re = "(.{$n})" . '.*\0.*\1' x ( @_ - 1 );
last unless $strings =~ $re;
$lcs = $1
}
return $lcs;
}
Benchmark: running buk, index, regex for at least 5 CPU seconds...
buk: 6 wallclock secs ( 5.31 usr + 0.01 sys = 5.32 CPU) @ 19
+73.50/s (n=10499)
index: 5 wallclock secs ( 5.29 usr + 0.01 sys = 5.30 CPU) @ 30
+23.77/s (n=16026)
regex: 6 wallclock secs ( 5.29 usr + 0.00 sys = 5.29 CPU) @ 93
+1.00/s (n=4925)
Rate regex buk index
regex 931/s -- -53% -69%
buk 1973/s 112% -- -35%
index 3024/s 225% 53% --