perl比較兩個字符串並突出顯示不匹配字符

string1 = "AAABBBBBCCCCCDDDDD" 
string2 = "AEABBBBBCCECCDDDDD"

輸出。如果不匹配（在這種情況下爲E）將用E標記的HTML標籤替換，即爲它着色。perl比較兩個字符串並突出顯示不匹配字符

A**E**ABBBBBCC**E**CCDDDDD

我到目前爲止嘗試過：XOR，diff和substr。首先，我需要找到這些指標，然後用這個模式替換這些指標。

來源

2013-05-21 Jabda

是大小兩個字符串總是一樣的？ – Bill

他們不是，但我比較string1的大小相同的字符串的子字符串。基本上假設他們是。 – Jabda

輸出是突出顯示差異的第二個字符串 – Jabda

use strict; 
use warnings; 
my $string1 = 'AAABBBBBCCCCCDDDDD'; 
my $string2 = 'AEABBBBBCCECCDDDDD'; 
my $result = ''; 
for(0 .. length($string1)) { 
    my $char = substr($string2, $_, 1); 
    if($char ne substr($string1, $_, 1)) { 
     $result .= "**$char**"; 
    } else { 
     $result .= $char; 
    } 
} 
print $result;

打印A**E**ABBBBBCC**E**CCDDDDD

有些測試。可能包含錯誤。

來源

2013-05-22 00:04:09 mzedeler

如果您需要非常高的性能（即字符串非常長），還有其他方法可以做到這一點。 – mzedeler

字符串不長，但有很多字符串。即多次比較 – Jabda

如果遇到性能問題，請嘗試此操作以開始併發布新問題。將每個字符串與其他字符串進行多次比較還是隻比較一次？ – mzedeler

有幾種方法可以做到這一點。以下是解決這個問題的可能方法。

my $str1="ABCDEA"; 
my $str2="AECDEB"; 
my @old1=split("",$str1); 
my @old2=split("",$str2); 

my @new; 

for my $i (0..$#old1) { 
     if ($old1[$i] eq $old2[$i]) { 
       push (@new, $old2[$i]); 
     } 
     else 
     { 
       my $elem = "**".$old2[$i]."**"; 
       push (@new , $elem); 
     } 
} 
print @new;

的輸出是：

A**E**CDE**B**

來源

2013-05-22 00:13:19 Bill

您應該遍歷字符串2，因爲OP指出輸出必須是字符串2，並突出顯示差異（在您的情況下，輸出的字符數與字符串1 ...字符串2的字符數可能更長一樣多） –

use warnings; 
use strict; 
my ($s1, $s2, $o1, $o2) = ("AAABBBBBCCCCCDDDDD", "AEABBBBBCCECCDDDDD"); 
my @s1 = split(//, $s1); 
my @s2 = split(//, $s2); 
my $eq_state = 1; 
while (@s1 and @s2) { 
    if (($s1[0] eq $s2[0]) != $eq_state) { 
     $o1 .= (!$eq_state) ? "</b>" : "<b>"; 
     $o2 .= (!$eq_state) ? "</b>" : "<b>"; 
    } 
    $eq_state = $s1[0] eq $s2[0]; 
    $o1.=shift @s1; 
    $o2.=shift @s2; 
} 
print "$o1\n$o2\n";

輸出

A<b>A</b>ABBBBBCC<b>C</b>CCDDDDD 
A<b>E</b>ABBBBBCC<b>E</b>CCDDDDD

一種更簡單的一個只打印出第二串：

use warnings; 
use strict; 
my ($s1, $s2, $was_eq) = ("AAABBBBBCCCCCDDDDD", "AEABBBBBCCECCDDDDD", 1); 
my @s1 = split(//, $s1); 
my @s2 = split(//, $s2); 
for my $idx (0 .. @s2 -1) { 
    my $is_eq = $s1[$idx] eq $s2[$idx]; 
    print $is_eq ? "</b>" : "<b>" if ($was_eq != $is_eq); 
    $was_eq = $is_eq; 
    print $s2[$idx]; 
}

Outout

</b>A<b>E</b>ABBBBBCC<b>E</b>CCDDDDD

來源

2013-05-22 00:14:21 perreal

+1用於實際迭代字符串2而不是string1 –

這可能是內存密集型，對於大字符串。

use strict; 
use warnings; 

my $a = "aabbcc"; 
my $b = "aabdcc"; 

my @a = split //, $a; 
my @b = split //, $b; 

my $new_b = ''; 

for(my $i = 0; $i < scalar(@a); $i++) { 
    $new_b .= $a[$i] eq $b[$i] ? $b[$i] : "**$b[$i]**"; 
}

OUTPUT：

$ test.pl 
new_b: aab**d**cc

來源

2013-05-22 00:14:59 chrsblck

你應該遍歷字符串2，因爲OP指出輸出必須是字符串2，並突出顯示不同的字符（在你的情況下，輸出的字符數與字符串1 ...字符串2的字符數可能更長） –

my @x = split '', "AAABBBBBCCCCCDDDDD"; 
my @y = split '', "AEABBBBBCCECCDDDDD"; 

my $result = join '', 
      map { $x[$_] eq $y[$_] ? $y[$_] : "**$y[$_]**" } 
      0 .. $#y;

來源

2013-05-22 02:13:35 FMc

+1遍歷字符串2） –

對齊列，使用逐字符串運算「^」：

my $a = "aabbccP"; 
my $b = "aabdccEE"; 
$_ = $a^$b; 
s/./ord $& ? "^" : " "/ge; 
print "$_\n" for $a, $b, $_;

給出：

aabbccP 
aabdccEE 
^^^

來源

2015-05-23 01:18:53

perl比較兩個字符串並突出顯示不匹配字符

回答

相關問題