Question

我正在使用perl脚本在两个制表符分隔的文件中查找列之间的匹配项。但是对于一列我只想查找两列中两个字符串之间的部分匹配。

它涉及$ table2的$ row [4]和$ table1的$ row {d}。 $ table2的$ row [4]中的值如下所示： 'XXXX'。 $ table1的$ row {d}中的值如下所示： 'xxxx.aaa'。

如果'。'之前的部分是一样的，有一个匹配。如果没有，则没有匹配。我不确定如何在我的脚本中实现它。这就是我到目前为止所拥有的。我只查找不同列之间的完全匹配。 '...'表示对此问题不重要的代码

#! /usr/bin/perl
use strict;
use warnings;

use Data::Dumper;
local $Data::Dumper::Useqq = 1;
use Getopt::Long qw(GetOptions);

...

...

chomp( my @header_table2 = split /\t/, <$table2> );

my %lookup;
while(<$table2>){
    chomp;
    my @row = split(/\t/);
    $lookup{ $row[0] }{ $row[1] }{ $row[4] }{ $row[5] }{ $row[6] }{ $row[7] }{ $row[8] } = [ $row[9], $row[10] ];
    } 

my @header = do {
    my $header = <$table1>;
    $header =~ s/\t?\n\z//;
    split /\t/, $header;
   };

print $table3 join ("\t", @header, qw/ name1 name2 /), "\n";


{
no warnings 'uninitialized';
while(<$table1>){
    s/\t?\n\z//;
    my %row;
    @row{@header} = split /\t/;
    print $table3 join ( "\t", @row{@header},
                   @{ $lookup{ $row{a} }{ $row{b} }{ $row{c} }{ $row{d} }{ $row{e} }{ $row{f} }{ $row{g} }
                        // [ "", "" ] }), "\n";
}
}

Answer 1

您将遇到范围问题，因为您的数组@row和您的哈希%row都存在于完全不同的范围内。

但如果您有变量（例如，$foo和$bar），并且您想知道$foo是否以$bar的内容后跟一个点开头，那么你可以使用正则表达式检查这样做：

if ($foo =~ /^$bar\./) {
  # match
} else {
  # no match
}

Answer 2

这看起来像是数据库的工作

以下解决方案无法正常运行，因为您正在使用九个级别的密钥（%lookup .. $row[0]）构建$row[8]哈希，并使用以下方法访问它只有七个级别（$row{a} .. $row{g}），因此您必须在实际情况下进行编辑

我认为没有理由如此深入地挖掘你的哈希。在相关字段上使用join形成的单个密钥可以正常工作，可能会更快一些。我也没有理由将table2字段提取到数组中，将table1字段提取到哈希中。

两种情况下阵列似乎都很好

我已经通过将@row中的每个table1复制到数组@key中，并在构建{$key之前删除了最后一个点以及第四个元素后面的任何内容来解决您的问题{1}}字符串

鉴于您在每条记录末尾的换行符之前添加备用制表符字符的历史记录，我还添加了四个die语句，用于验证标题行和列行的大小持续。您可能需要根据实际数据调整这些值

use strict;
use warnings 'all';

use Data::Dumper;
local $Data::Dumper::Useqq = 1;
use Getopt::Long qw(GetOptions);

use constant TABLE1_COLUMNS => 9;
use constant TABLE2_COLUMNS => 11;

open my $table2, '<', 'table2.txt' or die $!;

my @header_table2 = do {
    my $header = <$table2>;
    $header =~ s/\t?\n\z//;
    split /\t/, $header;
};
die "Incorrect table 2 header count " . scalar @header_table2
    unless @header_table2 == TABLE2_COLUMNS;

my %lookup;

while ( <$table2> ) {
    chomp;
    my @row = split /\t/;
    die "Incorrect table 2 column count " . scalar @row
        unless @row == TABLE2_COLUMNS;

    my $key = do {
        local $" = "\n";
        "@row[0..8]";
    };

    $lookup{ $key } = [ @row[9,10] ];
} 

open my $table1, '<', 'table1.txt' or die $!;

my @header = do {
    my $header = <$table1>;
    $header =~ s/\t?\n\z//;
    split /\t/, $header;
};
die "Incorrect table 1 header count " . scalar @header
    unless @header == TABLE1_COLUMNS;


open my $table3, '>', 'table3.txt' or die $!;


print $table3 join ("\t", @header, qw/ name1 name2 /), "\n";


while ( <$table1> ) {

    s/\t?\n\z//;

    my @row = split /\t/;
    die "Incorrect table 1 column count " . scalar @row
        unless @row == TABLE1_COLUMNS;

    my $key = do {
        my @key = @row;
        $key[3] =~ s/\.[^.]*\z//;
        local $" = "\n";
        "@key";
    };

    my $lookup = $lookup{ $key } // [ "", "" ];

    print $table3 join("\t", @row, @$lookup), "\n";
}

perl匹配两个文件中字符串的一部分

2 个答案: