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

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

这看起来像一个数据库

下面的解决方案是行不通的工作，因为你是用九级按键（$row[0] ... $row[8]）构建%lookup散列，并用它访问ONL y七个级别（$row{a} .. $row{g}），所以你将不得不在真实情况下编辑

我看不出有什么理由让你的散列如此深入。在相关字段上使用join形成的单个密钥可以正常工作，并且可能会更快一些。我也没有理由将table2字段提取到数组中并将table1字段提取到哈希中。数组似乎在这两种情况下细

我已经从table1每个@row复制到阵列@key，除去最后一个点，建设$key串

在从之前的第四个元素任何以下解决立即解决问题查看您在每条记录末尾的换行符之前添加备用制表符的历史记录，还添加了四条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"; 
}