簡單的方法來比較一個行中的某個位置中的字符與同一位置上的其餘行（Perl）的簡單方法

Question

我有一堆文件，想要比較以查看特定列的所有字符是否與在Perl中的文件的其餘部分。例如，如果我有一個文件：

abcdefg 
avcddeg 
acbdeeg 

的文件會讀一個，d，G作爲比賽和返回的位置。

我在考慮在perl中使用二維數組來遍歷和比較整個文件，但它可能會變得乏味。有沒有人有一個更簡單的方法來做到這一點？

感謝

Answer 1

您也可以逐行讀取文件中的行，標誌着數組元素一樣undef時，有一個行其有沒有共同的對手：

use strict; 
use warnings; 

open(my $read,"<","input_file") or die $!; 

my $first=1; #Flag to indicate whether or not we are on the first line. 
my @characters=(); #Array for characters 

while(my $line=<$read>) 
{ 
    chomp($line); 
    if($first) 
    { 
    @characters=split(//,$line); 
    $first=0; 
    } 
    else 
    { 
    my @temp_arr=split(//,$line); 

    foreach(0..$#characters) 
    { 
     $characters[$_]=undef unless $characters[$_] eq $temp_arr[$_]; 
    } 
    } 

    #If we do not have any characters in common, bail out! 
    unless(scalar(grep{defined($_)}@characters)) 
    { 
    print "Sorry, there are no characters in common positions within all rows of file input_file\n"; 
    exit(1); 
    } 
} 

close($read); 

print "Here are the common characters and positions:\n\n"; 

foreach(0..$#characters) 
{ 
    print "" . ($_ + 1) . ": " . $characters[$_] . "\n" if defined($characters[$_]); 
} 

對於輸入您的問題，輸出是：

Here are the common characters and positions: 

1: a 
4: d 
7: g 

注意，該代碼假定所有線路都具有相同的長度（或者，至少是，無線比t長他第一線）。如果情況並非如此，那麼您需要相應地調整代碼。

Answer 2

由於您需要將每個索引與其他索引進行比較以確定完整匹配，因此我不確定如何使其不那麼繁瑣。您可以避免使用子字符串構建二維數組。

my @matchedIndexes; 
my $pattern = "abcdefg"; 
INDEX: 
for $index (0 .. (length($pattern) - 1)){ 
    for $line (@remainingLines){ 
     #if we find a nonmatch at the index, cut out. 
     if (!(substr($line, $index, 1) == substr($pattern, $index, 1)){ 
      next INDEX; 
     } 
    } 
    #if we made it here without cutting out, the whole set of lines matched. 
    push @matchedIndexes, $index; 
} 

Answer 3

您可以使用按位xor ^。 Xoring兩個字符串在郵件中的字符串相同時留下零。

use warnings; 
use strict; 

my $previous; 
my $first = 1; 
while (<>) { 
    chomp; 
    $previous = $_ if $first; 
    undef $first; 
    my $in = $previous^$_; 
    my $p; 
    my @u = unpack 'c*', $in; 
    $p .= $u[$_] ? ' ' : substr $previous, $_, 1 for 0 .. $#u; 
    $previous = $p; 
    last if $p =~ /^ +$/; # no more matches possible 
} 

print pos $previous, ": $1\n" while $_ = $previous =~ /(\S)/g; 

Answer 4

效率不高和內存餓了，但相當可讀明瞭：

use strict;use warnings; 

my $lead = <DATA>; 
chomp $lead; 
my $rest = do { local $/; <DATA> }; 

for (my $i = 0; $i < length $lead; $i++) { 
    my $char = substr $lead, $i, 1; 
    next if $rest =~ /^.{$i}[^\Q$char\E]/m; 
    print "$i:$char\n"; 
} 


__DATA__ 
abcdefg 
avcddeg 
acbdeeg 

Answer 5

下面是使用逐OPS一個聰明的（和快速）的解決方案。它依賴於a & b & ... & z等於a | b | ... | z的事實，當且僅當所有的a,b，...，z是相等的。

# read first line: 
chomp($_ = <>); 
my $join = my $meet = $_; 

# read other lines: 
while(<>) { 
    chomp; 
    $join |= $_; 
    $meet &= $_; 
} 

# print matching columns: 
foreach my $i (0 .. length($meet) - 1) { 
    my $a = substr $join, $i, 1; 
    my $b = substr $meet, $i, 1; 
    print "$i: $a\n" if $a eq $b; 
} 

測試輸入：

abcdefg 
avcddeg 
acbdeeg 

輸出：

0: a 
3: d 
6: g 

聚苯乙烯。即使線路長度不同，該解決方案也能正常工作。在最短行結束之後沒有列將被視爲匹配。