perlは2つのファイルの文字列の一部と一致します

Question

私は、2つのタブ区切りファイルで列間の一致を探すためにperlスクリプトを使用しています。しかし、1つの列については、2つの列の2つの文字列の部分一致を探したいだけです。

$ table2の$ row [4]と$ table1の$ row {d}です。 $ table2の$ row [4]の値は、 'xxxx'のようになります。 $ table1の$ row {d}の値は、 'xxxx.aaa'のようになります。

「。」の前の部分が同じです、一致があります。一致しない場合、一致するものはありません。私はこのスクリプトをスクリプトに実装する方法がわかりません。これは私がこれまで持っていたものです。私は、異なる列間の完全一致を探すだけです。 「...」あなたは、アレイ@rowとあなたのハッシュ%rowの両方が完全に異なるスコープに存在するため、スコープの問題を抱えているとしているこの質問

#! /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

のために重要ではないコードを示しています。

しかし、あなたは、変数（たとえば、$fooと$bar）を持っていて、$barの内容に$foo開始は、ドットが続くかどうかを知りたい場合は、このような正規表現のチェック使用していることを行うことができます。

を

Answer 2

この

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

では、キーの9つのレベル（ $row[0] .. $row[8]）を使用して %lookupハッシュを構築しているので、以下のソリューションが仕事に行くされていないデータベース

のための仕事のように見える、として、それをアクセスしていますオングルyの7つのレベル（$row{a} .. $row{g}）ですので、実際の状況で編集する必要があります。

私は次にあなたのハッシュを深く考える理由はありません。関連するフィールドにjoinを使用して形成された単一のキーは正常に動作し、おそらく少し速くなります。 table2フィールドを配列に、table1フィールドをハッシュに抽出する理由もありません。私は配列@keyにtable1から各@rowをコピーし、そして最後のドットを削除し、何で$key文字列

を構築する前に、4番目の要素から、以下のことで、あなたの当面の問題を解決してきました

配列は、両方のケースで罰金です各レコードの末尾に改行の前に余分なタブ文字を追加した履歴を見ると、ヘッダ行と列行のサイズを確認する4つの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"; 
}