I benchmarked the suggested solutions, here are the results using the Albannach's list:
Benchmark: timing 100000 iterations of Albannach, Jenda, artist, bobn,
+ demerphq, tilly, tye, yosefm...
Albannach: 9 wallclock secs ( 8.75 usr + 0.00 sys = 8.75 CPU) @ 11
+424.65/s
Jenda: 2 wallclock secs ( 2.21 usr + 0.00 sys = 2.21 CPU) @ 45
+187.53/s
artist: 89 wallclock secs (86.88 usr + 0.00 sys = 86.88 CPU) @ 11
+50.96/s
bobn: 7 wallclock secs ( 7.69 usr + 0.00 sys = 7.69 CPU) @ 13
+002.21/s
demerphq: 28 wallclock secs (27.22 usr + 0.00 sys = 27.22 CPU) @ 36
+73.90/s
tilly: 4 wallclock secs ( 3.89 usr + 0.00 sys = 3.89 CPU) @ 25
+733.40/s
tye: 5 wallclock secs ( 4.37 usr + 0.00 sys = 4.37 CPU) @ 22
+899.02/s
yosefm: 25 wallclock secs (24.50 usr + 0.00 sys = 24.50 CPU) @ 40
+82.30/s
and here using a slightly longer list:
@files = qw(model4run1 model4rundfsdf model2run1 model4run2 model1run1
+ modelka
modelujeme modeluji modelme modelsdfgsdfg);
...
Benchmark: timing 100000 iterations of Albannach, Jenda, artist, bobn,
+ demerphq, tilly, tye, yosefm.
..
Albannach: 17 wallclock secs (15.34 usr + 0.01 sys = 15.35 CPU) @ 65
+13.81/s
Jenda: 4 wallclock secs ( 3.31 usr + 0.01 sys = 3.32 CPU) @ 30
+075.19/s
artist: 268 wallclock secs (250.31 usr + 0.04 sys = 250.35 CPU) @
+ 399.44/s
bobn: 13 wallclock secs (12.90 usr + 0.00 sys = 12.90 CPU) @ 77
+52.54/s
demerphq: 59 wallclock secs (57.94 usr + 0.01 sys = 57.95 CPU) @ 17
+25.54/s
tilly: 11 wallclock secs ( 8.01 usr + 0.02 sys = 8.03 CPU) @ 12
+453.30/s
tye: 11 wallclock secs (10.35 usr + 0.00 sys = 10.35 CPU) @ 96
+58.10/s
yosefm: 33 wallclock secs (31.75 usr + 0.00 sys = 31.75 CPU) @ 31
+50.00/s
Here is the code:
use Benchmark;
@files = qw(model4run1 model2run1 model4run2 model1run1 model);
sub bobn {
my @files = @_;
my $posn = -1;
my $same = 1;
while(defined $same and $posn <= length $files[0]){
my $chr = substr($files[0], ++$posn, 1);
for my $name (@files) {
undef $same and last if(substr($name, $posn, 1) ne $chr
or length $name < $posn);
}
}
return substr($files[0], 0, $posn);
}
sub Albannach {
my @files = @_;
my $posn = -1;
my $same = 1;
while(defined $same){
die if $posn > length $files[0];
my $chr = substr($files[0], ++$posn, 1);
for my $name (1..$#files) {
undef $same and last if(substr($files[$name], $posn, 1) ne $ch
+r
or length $files[$name] < $posn)
+;
}
}
return substr($files[0], 0, $posn);
}
sub Jenda {
my @files = @_;
my $first = shift(@files);
my $combined = $first;
foreach (@files) {
$combined &= $_;
}
$combined ^= $first;
$combined =~ s/[^\x00].*//;
return substr($first, 0, length($combined));
}
sub tye {
my @files = @_;
my $model= pop @files;
my $len= length($model);
for my $item ( @files ) {
my $dif= $model ^ substr($item,0,$len);
$len= length( ( $dif =~ /^(\0+)/ )[0] );
substr( $model, $len )= "";
}
return $model;
}
sub artist {
my @files = @_;
my @array = split //,shift @files;
my @prefix;
foreach (@files) {
@prefix = ();
while ($c = shift @array) {
next unless /^$c/;
s/^$c//;
push @prefix,$c;
}
@array = @prefix;
}
return (join ""=>@prefix);
}
sub yosefm {
my @files = @_;
PREF: for my $i (0..length($files[0])-1) {
my $substr = substr($files[0], 0, $i+1);
(/^$substr/ or return substr($files[0], 0, $i))
for (@files[1..$#files]);
}
}
sub tilly {
my @files = @_;
my $sep = chr(033);
my $str = join $sep, @files;
if ($str =~ /^([^$sep]*)[^$sep]*($sep\1[^$sep]*)*\z/s) {
return $1;
}
else {
die "Pattern unexpectedly failed to match?";
}
}
sub insert {
my $trie=shift;
my $str=shift;
$trie=$trie->{$_}||={}
foreach (split //,$str);
}
sub common {
my $trie=shift;
my $common="";
while (1==scalar keys %$trie) {
my $char=(keys %$trie)[0];
$common.=$char;
$trie=$trie->{$char};
}
$common;
}
sub demerphq {
my @files = @_;
my %trie;
insert(\%trie,$_) foreach @files;
return common(\%trie);
}
print "bobn: " . bobn(@files) . "\n";
print "Albannach: " . Albannach(@files) . "\n";
print "Jenda: " . Jenda(@files) . "\n";
print "tye: " . tye(@files) . "\n";
print "artist: " . artist(@files) . "\n";
print "yosefm: " . yosefm(@files) . "\n";
print "tilly: " . tilly(@files) . "\n";
print "demerphq: " . demerphq(@files) . "\n";
timethese 100000, {
bobn => sub {bobn(@files)},
Albannach => sub {Albannach(@files)},
Jenda => sub {Jenda(@files)},
tye => sub {tye(@files)},
artist => sub {artist(@files)},
yosefm => sub {yosefm(@files)},
tilly => sub {tilly(@files)},
demerphq => sub {demerphq(@files)},
}
Jenda
Always code as if the guy who ends up maintaining your code
will be a violent psychopath who knows where you live.
-- Rick Osborne
Edit by castaway: Closed small tag in signature
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.