Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Re^2: Tell whether two strings differ at only one position

by rg0now (Chaplain)
on Aug 04, 2005 at 21:14 UTC ( #481024=note: print w/ replies, xml ) Need Help??


in reply to Re: Tell whether two strings differ at only one position
in thread Tell whether two strings differ at only one position

I adopted Albannach's nice benchmark (thanks Albannach) and reBenchmarked all the solutions again. But now, for data, I used a random set of nice Hungarian words. Here are the results:

               Rate    rg0now  ikegami Not_a_Number BrowserUk   blazar     japhy
rg0now        288/s        --     -66%         -82%      -95%     -96%      -97%
ikegami       849/s      195%       --         -45%      -87%     -88%      -90%
Not_a_Number 1557/s      441%      83%           --      -76%     -78%      -83%
BrowserUk    6382/s     2118%     652%         310%        --     -10%      -28%
blazar       7084/s     2362%     735%         355%       11%       --      -20%
japhy        8900/s     2993%     949%         472%       39%      26%        --

It seems that japhy's solution is the clear winner, even if it is degraded to a sub call. I think that your results might be attributed your specific choice of data, but I do not know enough about the intrinsics of Perl string handling to say the decisive words (in fact, I do not know anything about it, so...)

use strict; use warnings; use Benchmark qw(:all); sub compare_rg0now { return 0 unless length $_[0] == length $_[1]; return 1 if $_[0] eq $_[1]; my $diff = 0; my @l1 = split //, $_[0]; my @l2 = split //, $_[1]; for(my $i = 0; $i < scalar @l1; $i++){ $diff++ if $l1[$i] ne $l2[$i]; return 0 if $diff > 1; } return 1; } sub compare_blazar { (my $xor=$_[0]^$_[1]) =~ tr/\0//d; length $xor < 2; } sub compare_BrowserUk { return ( length $_[0] == length $_[1] ) && ( length( $_[0] ) - 1 <= ( $_[0] ^ $_[1] ) =~ tr[\0][\0] ) } sub compare_ikegami { return unless length $_[0] == length $_[1]; # Omit if expecting differences almost all the time. return 1 if $_[0] eq $_[1]; my $limit = 1; foreach (split('', $_[0]^$_[1])) { next unless ord; return 0 unless $limit--; } return 1; } sub compare_japhy{ (($_[0] ^ $_[1]) =~ tr/\0//c) < 2; } sub compare_Not_a_Number { return 0 unless length $_[0] == length $_[1]; my $diff = 0; for ( 0 .. length $_[0] ) { $diff++ if substr( $_[0], $_, 1 ) ne substr( $_[1], $_, 1 ); return 0 if $diff > 1; } return 1; } my @data = ( [ qw( üzletágak üzletiség ) ], [ qw( üzemelhet üzemelget ) ], [ qw( üvölthető üvöltetés ) ], [ qw( üvegházak üveggyári ) ], [ qw( üvegesség üvegesedő ) ], [ qw( ütőkártya üttethető ) ], [ qw( ütemezhet ütemezget ) ], [ qw( üstöllést ürüszelet ) ], [ qw( üresíthet üresített ) ], [ qw( üregelhet üregelget ) ], [ qw( ülésezett ültetvény ) ], [ qw( ülepíthet ülepített ) ], [ qw( üldözhető üldözgető ) ], [ qw( ügynökölő ügynökölt ) ], [ qw( ügyesedés ügyesedik ) ], [ qw( üdültetés üdülgetés ) ], [ qw( ücsörögés ücsörgött ) ], [ qw( úzvölgyei útvonalak ) ], [ qw( útjavítás útitársak ) ], [ qw( úthálózat útelzárás ) ], [ qw( úszógatya úszásiság ) ], [ qw( úszkálgat úrvacsora ) ], [ qw( újságírói újságírás ) ], [ qw( újsziváci újszfalui ) ], [ qw( újrázandó újraírhat ) ], [ qw( újperinti újpaulisi ) ], [ qw( újrázandó újraírhat ) ], [ qw( újperinti újpaulisi ) ], [ qw( újlacskai újkígyósi ) ], [ qw( újféleség újegyházi ) ], [ qw( újbezdáni újbaresdi ) ], [ qw( öveztetés övezgetés ) ], [ qw( ötödszöri ötödnapra ) ], [ qw( ötvözendő ötvenórai ) ], [ qw( ötvenfelé ötvenezer ) ], [ qw( ötszöghez ötrubeles ) ], [ qw( ötfokúság ötezredik ) ], [ qw( ösztökélő ösztökélt ) ], [ qw( összjáték összhatás ) ], [ qw( összevont összevert ) ], [ qw( összerázó összenőve ) ], [ qw( összenője összenődd ) ], [ qw( összegező összefont ) ], [ qw( örömtelen örömködés ) ], [ qw( örököltet örökölhet ) ], [ qw( örökvirág örökmozgó ) ], [ qw( örökbecsű örvénylés ) ], [ qw( örménység örményesi ) ], [ qw( öregesség öregember ) ], [ qw( öregbéres öregbedés ) ], [ qw( ördögszem ördögkúti ) ], [ qw( önállósít önállóság ) ], ); cmpthese(-3, { 'rg0now' => sub {for(@data) {compare_rg0now(@$_)} + }, 'blazar' => sub {for(@data) {compare_blazar(@$_)} + }, 'BrowserUk' => sub {for(@data) {compare_BrowserUk(@$_ +)} }, 'ikegami' => sub {for(@data) {compare_ikegami(@$_)} + }, 'japhy' => sub {for(@data) {compare_japhy(@$_)} + }, 'Not_a_Number' => sub {for(@data) {compare_Not_a_Number( +@$_)} }, });


Comment on Re^2: Tell whether two strings differ at only one position
Download Code
Re^3: Tell whether two strings differ at only one position
by Your Mother (Canon) on Aug 05, 2005 at 01:34 UTC

    Playing more than understanding. Using the same benchmarks I got about a 3-5% speed up with a modified version of blazar's which skips lexical assignment by using $_. Tried a few arrangements with length and local and this was the fastest I stumbled on. OS X, v5.8.2.

    sub compare_blazar_mod { ( $_ = $_[0] ^ $_[1] ) =~ tr/\0//d; 2 < length; }
Re^3: Tell whether two strings differ at only one position
by BrowserUk (Pope) on Aug 05, 2005 at 03:00 UTC

    Both blazar's and japhy's return true when passed 'fred', 'freda' which obviously isn't right.

    When you add the code to detect that error, you get:

    Rate rg0now ikegami Not_a_Number blazar japhy + BrowserUk rg0now 412/s -- -69% -85% -96% -96% + -96% ikegami 1311/s 218% -- -54% -86% -88% + -89% Not_a_Number 2842/s 589% 117% -- -70% -74% + -75% blazar 9628/s 2236% 634% 239% -- -13% + -17% japhy 11086/s 2590% 745% 290% 15% -- + -4% BrowserUk 11580/s 2709% 783% 307% 20% 4% + --

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
    "Science is about questioning the status quo. Questioning authority".
    The "good enough" maybe good enough for the now, and perfection maybe unobtainable, but that should not preclude us from striving for perfection, when time, circumstance or desire allow.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (6)
As of 2014-09-17 00:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (55 votes), past polls