Perl 根据模式从字符串矩阵中删除字符

Question

我有多个长度相同的字符串存储在哈希数据结构中。 示例：

$VAR1 = {
          'first' => 'abcXY',
          'second' => 'XYXYa',
          'third' => '*abXZ'
        };

从这 'matrix' 个字符中，我想删除仅包含字符 X 或 Y 的 'columns'。在上面的示例中，这将是每个字符串的第四个字符 (4th 'column')。期望的结果是：

$VAR1 = {
          'first' => 'abcY',
          'second' => 'XYXa',
          'third' => '*abZ'
        };

以下代码通过创建哈希结构值的转置然后确定要保留的索引来完成此操作：

# data structure
my %h = ('first'=>'abcXY', 'second'=>'XYXYa', 'third'=>'*abXZ' );

# get length of all values in hash
my $nchar = length $h{(keys(%h))[0]};

# transpose values of hash
my @transposed = map { my $idx=$_; [map {substr ($_, $idx, 1) } values(%h)]  } 0..$nchar-1; 

# determine indices which I want to keep
my @indices;
for my $i (0..$#transposed){
        my @a = @{$transposed[$i]};

        # do not keep index if column consists of X and Y
        if ( scalar(grep {/X|Y/} @a) < scalar(@a) ) {
                push @indices, $i;
        }   
}

# only keep letters with indices
for my $k (keys %h){
        my $str = $h{$k};
        my $reduced = join "", map{ substr ($str, $_, 1) } @indices;
        $h{$k} = $reduced;
}

对于如此简单的操作，代码量实在是太可怕了。我怎样才能更优雅地做到这一点（最好不要使用某些矩阵库，而是使用标准的 perl）？

编辑

这里是另一个例子：从下面的字符串中，第一个和最后一个字符应该被删除，因为在这两个字符串中，第一个和最后一个位置要么是 X 要么是 Y:

$VAR1 = {
          '1' => 'Xsome_strX',
          '2' => 'YsomeXstrY'
        };

想要的结果：

$VAR1 = {
          '1' => 'some_str',
          '2' => 'someXstr'
        };

Answer 1

my $total = values %hash;
my %ind;
for my $v (values %hash) {

  $ind{ pos($v) -1 }++ while $v =~ /[XY]/g;
}
my @to_remove = sort {$b <=> $a} grep { $ind{$_} == $total } keys %ind;

for my $v (values %hash) {

  substr($v, $_, 1, "") for @to_remove;
}

Perl 根据模式从字符串矩阵中删除字符

Perl remove characters from string matrix according to pattern

regex

string

perl

matrix