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

[rg0now]

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(
+@$_)} },
});

[BrowserUk]

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%
+        --

[Your Mother]

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;
}