在 perl 中比较两个字符串并找到不匹配和匹配并计算它们答案

【问题标题】：Compare two strings and find mismatch and match and count them both in perl在 perl 中比较两个字符串并找到不匹配和匹配并计算它们
【发布时间】：2019-12-26 18:16:45
【问题描述】：

比较两个字符串，找出不匹配和不匹配，并同时计算它们

string1 = "SEQUENCE"
string2 = "SEKUEAEE"

我想要像这样的输出。与不匹配和匹配计数。

'SS' match 1
'EE' match 3
'UU' match 1
'QK' mismatch 1
'NA' mismatch 1
'CE' mismatch 1

【问题讨论】：

我可以编写一个脚本来执行此操作，但是您如何从数组、哈希或文本文件中获取这些字符串？
你试过什么？你有什么问题？请向我们展示您的代码。

标签： string perl

【解决方案1】：

这是旧 Perl 的解决方案。也适用于你想要的任意数量的字符串

use warnings;
use strict;
use List::AllUtils qw( mesh part count_by pairs );

my @strings = ("SEQUENCES", "SEKUEAEES", "SEKUEAEES"); 

my $i = 0;

print join "",
    map { $_->[0] . " " . ($_->[1] > 1 ? 'match' : 'mismatch') . " " . $_->[1] ."\n" }
    pairs
    count_by { $_ }
    map { join "", @$_ }
    part { int($i++/scalar @strings) } 
    &mesh( @{[ map { [ split // ] } @strings ]} ) 
;

为了比较，Perl 6 中的类似代码。

my @strings = "SEQUENCES", "SEKUEAEES", "SEKUEAEES"; 

([Z] @strings>>.comb)
    .map({ .join })
    .Bag
    .map({ "{.key} { .value > 1 ?? 'match' !! 'mismatch' } {.value}\n" })
    .join
    .say;

这不是很漂亮吗？

【讨论】：

【解决方案2】：

适用于任意数量字符串的解决方案。

use List::Util qw(max);
use Perl6::Junction qw(all);

my @strings = qw(SEQUENCE SEKUEAEE);
my (%matches, %mismatches);
for my $i (0 .. -1 + max map { length } @strings) {
    my @c = map { substr $_, $i, 1 } @strings;
    if ($c[0] eq all @c) {
        $matches{join '', @c}++;
    } else {
        $mismatches{join '', @c}++;
    }
}
for my $k (keys %matches) {
    printf "'%s' match %d\n", $k, $matches{$k};
}
for my $k (keys %mismatches) {
    printf "'%s' mismatch %d\n", $k, $mismatches{$k};
}
__END__
'SS' match 1
'UU' match 1
'EE' match 3
'QK' mismatch 1
'NA' mismatch 1
'CE' mismatch 1

【讨论】：

【解决方案3】：

使用非核心但非常方便的List::MoreUtils 模块。

#!/usr/bin/env perl
use warnings;
use strict;
use feature qw/say/;
use List::MoreUtils qw/each_array/;

sub count_matches {
  die "strings must be equal length!" unless length $_[0] == length $_[1];
  my @letters1 = split //, $_[0];
  my @letters2 = split //, $_[1];
  my (%matches, %mismatches);
  my $iter = each_array @letters1, @letters2;
  while (my ($c1, $c2) = $iter->()) {
    if ($c1 eq $c2) {
      $matches{"$c1$c2"} += 1;
    } else {
      $mismatches{"$c1$c2"} += 1;
    }
  }
  say "'$_' match $matches{$_}" for sort keys %matches;
  say "'$_' mismatch $mismatches{$_}" for sort keys %mismatches;
}

count_matches qw/SEQUENCE SEKUEAEE/;

【讨论】：

你可能有更多的 Utils，但我有所有的 Utils。哈哈哈。（见下文）
@Holli 这让我想使用List::EvenMoreUtils。