Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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


In reply to Re: Find common prefix from a list of strings by Jenda
in thread Find common prefix from a list of strings by Albannach

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • 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.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (3)
As of 2024-03-29 05:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found