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"; 
}