Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Re: Find common prefix from a list of strings

by antirice (Priest)
on Jul 15, 2003 at 00:42 UTC ( #274241=note: print w/replies, xml ) Need Help??


in reply to Find common prefix from a list of strings

Yes, it is inspired by tye's version. However, in the spirit of TMTOWTDI:

sub Prefix { my ($m,$n) = (sort @_)[0,-1]; my $dif = $m ^ $n; my $len= length( ( $dif =~ /^(\0*)/ )[0] ); substr( $m, 0,$len ); }

Why sort? Since it's a builtin, it should be rather fast. Also, you're guaranteed that the first and last element of the sorted array will have the shortest prefix match of any two strings within the array. This sub is actually very fast.

use Benchmark; @files = qw(model4run1 model2run1 model4run2); sub antirice { my ($m,$n) = (sort @_)[0,-1]; my $dif= $m ^ $n; $len= length( ( $dif =~ /^(\0*)/ )[0] ); substr( $m, 0,$len ); } # not picking on Jenda, but he seems to have the fastest prior sub sub Jenda { my $first = shift(@_); my $and = $first; my $or = $first; foreach (@_) { $and &= $_; $or |= $_; } my $combined = $and ^ $or; $combined =~ s/[^\x00].*//; substr($first, 0, length($combined)); } print "Jenda: " . Jenda(@files) . "\n"; print "antirice: " . antirice(@files) . "\n"; timethese 100000, { Jenda => sub {Jenda(@files)}, antirice => sub {antirice(@files)} } __DATA__ Jenda: model antirice: model Benchmark: timing 100000 iterations of Jenda, antirice... Jenda: 1 wallclock secs ( 0.82 usr + 0.00 sys = 0.82 CPU) @ 12 +1904.76/s (n=100000) antirice: 1 wallclock secs ( 0.75 usr + 0.00 sys = 0.75 CPU) @ 13 +3333.33/s (n=100000)

antirice    
The first rule of Perl club is - use Perl
The
ith rule of Perl club is - follow rule i - 1 for i > 1

Replies are listed 'Best First'.
Re^2: Find common prefix from a list of strings
by AnomalousMonk (Bishop) on Feb 25, 2014 at 05:43 UTC

    Passes same tests as above, but with no capture or length call, might be slightly faster — but no benchmarking done. (I passed all arrays by reference in my testing.)

    sub Prefix { my ($ar_strings, ) = @_; return '' unless @$ar_strings; my ($m, $n) = (sort @$ar_strings)[0,-1]; ($m ^ $n) =~ m{ \A \x00* }xms; return substr $m, 0, $+[0]; }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://274241]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (7)
As of 2020-01-23 13:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?