Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

comment on

( #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":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

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

    How do I use this? | Other CB clients
    Other Users?
    Others perusing the Monastery: (3)
    As of 2020-01-18 12:39 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Notices?