Perl - レコードを集約して印刷できる汎用サブルーチン

Question

レガシーシステムからデータファイルを受け取り、処理してデータベースにロードします。入力ファイル（input.txtなど）は、2つの部分に分かれています。最初はデータ列、2番目は数値列です。このファイルで行う処理は、一部のデータ列を削除し、残りの列の数値を集計して（各レコードが一意のレコードになるようにする）ことです。

タブ区切り入力ファイルINPUT.TXTを以下に示す（column4にCOLUMN0 COLUMN7にデータ列とCOLUMN5は数字列されている）：

a b c h n 1.99 2.99 9 
a b c k q 100 100 10 
a b c m s 9.99 8.99 11 
a b d i o 0.01 0.01 12 
a b d j p -12.19 11.11 13 
a b e l r 9 9 14 

タブ区切り出力ファイルoutput.txtとが示されています以下のperlスクリプトは、column0、column1、column2を保持することで数値を集計します。スクリプトは正常に動作しています。

use strict; 

my $INPUT_FILE=shift @ARGV || die "You must supply the input as the first argument!!!\n"; 
my $OUTPUT_FILE=shift @ARGV || die "You must supply the output file as the second argument!!!\n"; 

open(my $out, ">", $OUTPUT_FILE) or die "Cannot open $OUTPUT_FILE for writing!\n"; 
open(my $in, "<", $INPUT_FILE) or die "Cannot open $INPUT_FILE for processing!\n"; 

my $data; 
while (<$in>) 
{ 
s/\r?\n$//; 
my @cols = split(/\t/); 
$data->{$cols[0]}->{$cols[1]}->{$cols[2]}->[0] += $cols[5]; 
$data->{$cols[0]}->{$cols[1]}->{$cols[2]}->[1] += $cols[6]; 
} 
close $in; 


foreach my $lev1 (sort keys %{$data}) 
{ 
foreach my $lev2 (sort keys %{$data->{$lev1}}) 
{ 
    foreach my $lev3 (sort keys %{$data->{$lev1}->{$lev2}}) 
    { 
     my $dataVal = $data->{$lev1}->{$lev2}->{$lev3}->[0]; 
     my $dataVal2 = $data->{$lev1}->{$lev2}->{$lev3}->[1]; 
     print $out "$lev1\t$lev2\t$lev3\t$dataVal\t$dataVal2\n"; 
    } 
} 
} 
close $out; 

質問：多くの異なるperlスクリプトで同じロジックを適用します。私は、 "require"ステートメントを使用して、すべての異なるスクリプトでソースできる汎用サブルーチンを作成したいと思います。サブルーチンは、出力を集約して出力する必要があります。このサブルーチンでは、集計に必要な列（現在はcolumn0からcolumn2）と集計する列の数（現在はcolumn5とcolumn6）について引数を受け入れる必要があります。ご意見をお聞かせください。

Answer 1

問題にアプローチする1つの方法は、すべてのパラメータを統合することから始めることです。あなたのプログラム全体に0,5,6、および"\t"のような定数を散らすのではなく、それらを束ねてください。

my %opt = (
    input_file => 'input.dat', 
    output_file => 'output.dat', 
    keep_cols => [0,1,2], 
    agg_cols => [5,6], 
    join_char => "\t", 
); 

次に、あなたはあなたの現在のスクリプトがよりモジュラーなるだろうどのように考えるかもしれない - これらの線に沿って何か：

use strict; 
use warnings; # Don't forget this. 

run(@ARGV); 

sub run { 
    my %opt = get_args(@_); 
    $opt{data} = read_input_file(%opt); 
    write_output_file(%opt); 
} 

sub get_args { 
} 

sub read_input_file { 
} 

sub write_output_file { 
} 

最後に、私はあなたのデータ構造を平らにすることをお勧めします。入力や読み込みに少し厄介かもしれないマルチレベルのハッシュを使用するのではなく、安全な区切り文字を使用して、さまざまなハッシュキーを複合文字列に結合するだけです。 DBD :: CSVを使用して、その上に

my @cols = split $opt{join_char}, $line; 
my $i = 0; 
my $k = join $opt{join_char}, @cols[ @{$opt{keep_cols}} ]; 
$data{$k}[$i ++] += $_ for @cols[ @{$opt{agg_cols }} ]; 

Answer 2

私の試み：read_input_file()の内部では、次のようないくつかのコードを持っているかもしれません。私が試したかったので、Mooseクラスでラップしました。

package MyDataParser; 

use Moose; 
use MooseX::Types::Path::Class; 

use DBI; 

has _dbd => (is => 'ro', isa => 'Object', lazy_build => 1,); 

has data_file => (is => 'rw', isa => 'Path::Class::File', required => 1, coerce => 1); 

has label_columns => (
    traits => ['Array'], 
    is => 'rw', 
    isa => 'ArrayRef[Int]', 
    required => 1, 
    handles => { 
     list_label_columns => 'elements', 
     add_label_column => 'push', 
     } 
    ); 

has data_columns => (
    traits => ['Array'], 
    is => 'rw', 
    isa => 'ArrayRef[Int]', 
    required => 1, 
    handles => { 
    list_data_columns => 'elements', 
    add_data_column => 'push', 
    } 
); 

    has _sql_query => (is => 'rw', isa => 'Str', lazy_build => 1,); 

    sub get_totals { 

    my $self = shift; 

    my $ar = $self->_dbd->selectall_arrayref($self->_sql_query); 
    die $DBI::errstr if $DBI::err; 


    foreach my $row (@$ar) { 
     print "@$row\n"; 

    } 

    } 

    sub _build__dbd { 

    my $self = shift; 

    my $dbh = DBI->connect ("dbi:CSV:"); 
     $dbh->{csv_tables}{data} = { 
      sep_char => "\t", 
      file  => $self->data_file, 
      col_names => ['column1' .. 'column8'], 
     }; 

     return $dbh; 

    } 

    sub _build__sql_query { 

    my $self = shift; 

    my @label_column_names = map {'column' . $_} $self->list_label_columns; 
    my @data_columns = map {"SUM(column$_)"} $self->list_data_columns; 

    my $labels_str = join ', ', @label_column_names; 
    my $data_columns_str = join ', ', @data_columns; 

    my $query = qq/SELECT $labels_str, $data_columns_str FROM data GROUP BY $labels_str/; 


    return $query; 
    } 



package main; 

use strict; 
use warnings; 

my $df = MyDataParser->new(data_file => 'data.txt', label_columns => [1,2,3], data_columns => [6,7,8]); 
    $df->get_totals; 

Answer 3

あなたの現在のソリューションは一般化することができます。最初の問題は、今後のプロジェクトで変化する可能性があるハードコーディングされたプログラムを特定することです。

あなたが一般化したいものは分かっていますが、オプションのFMのハッシュは非常に良い推測を提供します。私たちは私たちのデータのハッシュのキーとしてそれらを使用するつもりだので、私は、key_colsにkeep_colsを変更したこれらのオプションの2、

key_cols => [0,1,2], 
agg_cols => [5,6], 

に焦点を当ててみましょう。これら二つのオプションによって参照配列をループとして

あなたの現在の文のだと思い

# version 1, key cols and agg cols hardcoded 

$data->{$cols[0]}->{$cols[1]}->{$cols[2]}->[0] += $cols[5]; 
$data->{$cols[0]}->{$cols[1]}->{$cols[2]}->[1] += $cols[6]; 

。各パス上の

が

# version 2, generic agg cols, but key cols still hardcoded 

my @agg_cols = @$opt{agg_cols}; 
for my $i (0..$#agg_cols}) { 
    $data->{$cols[0]}->{$cols[1]}->{$cols[2]}->[$i] += $cols[$agg_col[$i]]; 
} 

今key_colsをループに、ちょうどあなたの$データrefの一時的なコピーを作成し、より深く、インデックス、それを：：

# version 3, generic agg cols and key cols 
my @agg_cols = @$opt{agg_cols}; 
my @key_cols = @$opt{key_cols}; 

my $current_ref = $data; 
for my $key_col (@key_cols) { 
    $current_ref = $current_ref->{$cols[$key_col]}; 
} 

for my $i (0..$#agg_cols}) { 
    $current_ref->[$i] += $cols[$agg_col[$i]]; 
} 

agg_cols上でループすることは簡単ですこのコードはwhile <$in>ループ内にありますが、agg_colsとkey_colsのオプションを一度上に読み込むと、リファクタリングする必要があります。