in reply to Detecting transpositions

This returns -1 if the answer is negative. 
sub comp {
    my ($f, $s) = @_;
    return -1 if length ($f) != length ($s);

    local $_ = $f ^ $s;
    return -1 unless tr/\x00/1/c == 2;

    index $_ => "11";
}

[download]

Abigail

Replies are listed 'Best First'.
Re: Re: Detecting transpositions
by sauoq (Abbot) on Aug 06, 2003 at 09:13 UTC

    Fixed:

    sub comp {
    my ($f, $s) = @_;
    return -1 if length ($f) != length ($s);

    local $_ = $f ^ $s;
    return -1 unless tr/\x00/1/c == 2;

    my $i = index $_ => "11";
    return -1 unless $i >= 0;
    return -1 unless substr($f, $i, 2) eq reverse substr($s, $i, 2);

    return $i;
}

    [download]
    -sauoq
"My two cents aren't worth a dime.";
[reply]
[d/l]
Re: Re: Detecting transpositions
by sgifford (Prior) on Aug 06, 2003 at 08:57 UTC
    That's cool, but it just looks for two consecutive differences, not for transposed characters. It gets confused comparing the strings "ab" and "bc", for example---it thinks they're transposed at character 0. That's probably fixable, but I'll have to think for a minute before I have a suggestion.
[reply]
      The examples suggested that both strings were anagrams of each other. However, here's a fix: 
      sub comp {
    my ($f, $s) = @_;
    return -1 if length ($f) != length ($s);

    local $_ = $f ^ $s;
    return -1 unless tr/\x00/1/c == 2;

    my $r = index $_, "11";

   (substr ($f, $r, 2) eq reverse substr ($s, $r, 2)) ? $r : -1;
}

      [download]

      Abigail

[reply]
[d/l]
        That does it. That's just a really cool solution. I didn't know xor worked on strings like that.
[reply]
[d/l]
        Or even shorter... Albeit about 3 times slower on long strings and 30% faster for short... 
        sub comp {
    local $_ = $_[0] ^ $_[1];
    return s/([^\x00])\1//g==1 && !tr/\x00/1/c;
}

        [download]


        T I M T O W T D I
[reply]
[d/l]
        Very cool. Can you explain why it works? What makes the XOR come out to be like that?
        A massive flamewar beneath your chosen depth has not been shown here
[reply]
        Hey! Thats really elegant and instructive Abigail-II - but please forgive a stupid question...
        Would it be possible for the product of $f ^ $s to contain a "1" and hence pollute your $_ string?


        "To be admired must be the constant aim of ambition."
        - Johnson
[reply]

In Section Seekers of Perl Wisdom