Re: Compare two strings of same length, character-by-character

I have done something similar where I have marked the differences in two strings, adding HTML markup to make the differences obvious. You might remove the HTML or do whatever suits your purposes:

use Algorithm::Diff qw(traverse_sequences);

#---------------------------------------------------------------------
+-------------
#                C O M P A R A T O R
#---------------------------------------------------------------------
+-------------

sub comparator {
my $str1 = shift @_;
my $str2 = shift @_;
my $original = '';
my $revised  = '';

my @from = split(/([ ,.:;"?!-])/, $str1);
my @to   = split(/([ ,.:;"?!-])/, $str2);

my $OS = q|<span class="m">|;
my $OE = q|</span>|;
my $RS = q|<span class="m">|;
my $RE = q|</span>|;

  traverse_sequences( \@from, \@to,
    {
    MATCH     => sub { 
        my $oldtext = $from[shift()]; 
         if ($oldtext =~ /<P>/) {
            $original .= "</p>\n<p>";
            $revised  .= "</p>\n<p>"
         } else {
            $original .= "$oldtext"; 
            $revised .= "$oldtext" 
         }
        },
    DISCARD_A => sub { 
         my $oldtext = $from[shift()]; 
         if ($oldtext =~ /<P>/) {
            $original .= "</p>\n<p>"
         } elsif ($original =~ m!</span>\s$!) {
             if ($oldtext =~ m/(?:[,.:;"?!-])/) {
                 $original =~ s/(?:<\/span>)*\s+$/$oldtext$OE/;       
+          
             } else {
                 $original =~ s/<\/span>\s$/ $oldtext$OE/;
             }
         } else {
            $original .= $OS.$oldtext.$OE 
         }
        },
    DISCARD_B => sub { 
        my $newtext = $to[pop()];     
         if ($newtext =~ /<P>/) {
            $revised .= "</p>\n<p>"
         } elsif ($revised =~ m!</span>\s$!) {
             if ($newtext =~ m/(?:[,.:;"?!-])/) {
                 $revised =~ s/(?:<\/span>)*\s+$/$newtext$RE/;
             } else {
                 $revised =~ s/<\/span>\s$/ $newtext$RE/;
             }
         } else {
             $revised  .= $RS.$newtext.$RE 
         }
        },
    } );
    
    $original =~ s~^(</p>)(.*+)$~$2$1~;
    $revised  =~ s~^(</p>)(.*+)$~$2$1~;
    
    return ($original, $revised);
    
} #END SUB comparator
[download]

Blessings,

~Polyglot~

Comment on Re: Compare two strings of same length, character-by-character Download Code

Replies are listed 'Best First'.
Re^2: Compare two strings of same length, character-by-character by tybalt89 (Monsignor) on Nov 29, 2023 at 21:25 UTC
If all that is needed is a count of how many characters are the same, this can be reduced to: `#!/usr/bin/perl use strict; # https://www.perlmonks.org/?node_id=11155923 use warnings; my $str1='LFGSLSIIVAHHM'; my $str2='LFGSLSIIVSHHM'; use Algorithm::Diff qw(traverse_sequences); my $same = 0; traverse_sequences( [ split //, $str1 ], [ split //, $str2 ], { MATCH => sub { $same++ }, } ); print "$same characters are the same\n";` [download] which outputs: `12 characters are the same` [download]	[reply] [d/l] [select]
Re^2: Compare two strings of same length, character-by-character by Polyglot (Chaplain) on Nov 29, 2023 at 10:06 UTC
I should have added that this is comparing by words based on the split rules given for @from and @to. It could be divided in other ways, I presume, such as by character. As it stands now, without word spaces, the script would highlight the entire string as different if even one character differed in it. Blessings, ~Polyglot~	[reply]
Re^3: Compare two strings of same length, character-by-character by karlgoethebier (Abbot) on Nov 29, 2023 at 11:35 UTC
Why don't you actually outsource your callbacks - as described in the Algorithm::Diff manual? The readability of your code would be significantly improved: `traverse_sequences( \@seq1, \@seq2, { MATCH => $callback_1, DISCARD_A => $callback_2, DISCARD_B => $callback_3, }, undef, # default key-gen $myArgument1, $myArgument2, $myArgument3, ); $callback_1 = sub {…}; $callback_2 = sub {…}; $callback_3 = sub {…};` [download] Instead of: `my $str1 = shift @_; my $str2 = shift @_;` [download] …write: `my ($str1,$str2) = @_;` The HTML thing is completely incomprehensible to me. Leave it out. «The Crux of the Biscuit is the Apostrophe»	[reply] [d/l] [select]