Perl - общая подпрограмма, которая может объединять записи и печатать

Question

Мы получаем файл данных из нашей прежней системы, обрабатываем его и загружаем в базу данных.Входной файл (скажем, input.txt) можно разделить по столбцам на две части: первая - столбцы данных, а вторая - столбцы чисел.Обработка этого файла заключается в удалении некоторых столбцов данных и агрегировании номеров оставшихся столбцов (чтобы каждая запись была уникальной).

Входной файл с разделителями табуляции input.txtпоказано ниже (столбец 0 - столбец 4 - столбцы данных, а столбец 5 - столбец 7 - столбец чисел):

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 с разделителями табуляции показан ниже:

a   b   c   111.98  111.98
a   b   d   -12.18  11.12
a   b   e   9   9

Следующий скрипт 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».Подпрограмма должна агрегировать и печатать выходные данные.Эта подпрограмма должна принимать аргументы относительно того, какие столбцы мне нужны для агрегирования (в настоящее время столбцы от 0 до column2) и числа, из которых должны быть агрегированы столбцы (в настоящее время column5 и column6).Пожалуйста, совет.

Answer 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 {
}

Наконец, я бы посоветовал вам сгладить структуру данных. Вместо того, чтобы использовать многоуровневый хеш, который может быть немного неудобным для ввода и чтения, просто объедините ваши различные ключи хеша в составную строку, используя любой безопасный разделитель. Внутри read_input_file() у вас может быть такой код:

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

Вы правы, ваше текущее решение может быть обобщено.Первая проблема состоит в том, чтобы определить жестко запрограммированные фрагменты вашей программы, которые, возможно, потребуются для различных проектов в будущем.

Только вы точно знаете, что хотите обобщить, но хэш опций FM предлагает вамочень хорошее предположение.Позвольте мне сосредоточиться на двух из этих опций,

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

, где я изменил keep_cols на key_cols, так как мы собираемся использовать их в качестве ключей в нашем хеше данных.

Думайте о своих текущих выражениях

# 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]; 

как о циклах над массивами, на которые ссылаются эти два параметра.Цикл по agg_cols является простой частью:

# 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, просто сделайте временную копию вашей ссылки на $ data и более глубоко индексируйте ее при каждом проходе:

# 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]];
}

Этот код принадлежит вашему циклу while <$in>, за исключением того, что вы захотите провести рефакторинг, прочитав параметры agg_cols и key_cols только один раз в верхней части.

Answer 3

Моя попытка использовать DBD :: CSV. Я обернул это в классе 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;