perl - 使用 Perl 将不规则数据转换为结构化表格

Question

我想使用 perl 将以下数据行转换为结构化表:

3=884|4=884|5=MBREFUSDCMR|25=113500|824=20120229|387=4.15|248=TLD|280=5
3=884|4=884|5=MBREFUSDCMR|24=1|12=0|10=0|25=113500|824=20120229|280=5
3=884|4=884|5=MBREFUSDCMR|24=1|270=252304|280=5

等号之前的每个值代表该标识符 对应的值。现在我想制作一张表格以供进一步 分析。第一行应包含标识符及其值下方。中的标识符数量不等 必须牢记的三行。缺失值应该是 用字符串“NA”填充。所以它应该看起来像这样

3|4|5|24|12|10|25|824|387|248|270|280
884|884|MBREFUSDCMR|NA|NA|NA|113500|20120229|4.15|TLD|NA|5
884|884|MBREFUSDCMR|1|0|0|113500|20120229|NA|NA|NA|5
884|884|MBREFUSDCMR|1|NA|NA|NA|NA|NA|NA|252304|5

@DVK

我的方法是首先获取所有变量。这将是表格的标题/第一行。例如

my @data_dirty = <STDIN>;
chomp(@data_dirty);

## get the columns names
my ( @tmp, @var );
foreach my $j (@data_dirty) {
    foreach my $i (split /\|/, $j) {
    $i =~ s/\[.*\]//g;
    $i =~ s/\s+//g;
    $i =~ s/(.*)=.*/$1/g;
    push(@tmp, $i);
    }
}
@var = uniq @tmp;

之后我可能会检查每一行@var中的变量是否存在，如果存在则写入相应的值，否则写入“NA”。但是，我在检查和正确存储数据方面遇到了一些麻烦，以便之后的输出看起来符合预期。

Answer 1

解决此类需求的关键是分而治之。您所需要的就是仔细选择子例程。

在这里，需要加载数据，并且在打印任何表格之前需要预先知道所有标识符。

下面的示例没有按列的出现顺序对列进行排序(留给读者作为练习):

use strict;
use warnings;

my ( $data, $headers ) = load_data( 'tabular_data.txt' );

print_tabular( $data, $headers );

sub load_data {

    my ( $file ) = @_;

    open my $fh, '<', $file or die $!;

    my ( @records, %fields );
    while ( my $line = <$fh> ) {

        chomp $line;

        my @columns = split /\|/, $line;               # Get columns
        my %entries = map { split /=/, $_ } @columns;  # Populate record,
                                                       # keys = fields
        push @records, \%entries;                      # Add to data collection

        $fields{$_}++ for keys %entries;               # Detect new headers
    }

    close $fh;

    return ( \@records, [ keys %fields ] );
}

sub print_tabular {

    my ( $data, $headers ) = @_;

    pretty_print( @$headers );

    for my $record ( @$data ) {
        my @values = map { exists $record->{$_}  # exists check needed...
                             ? $record->{$_}     # ... otherwise header '0'
                             : 'NA'              # ... would always print 'NA'
                         } @$headers;
        pretty_print( @values );
    }
}

sub pretty_print { print join( '|', @_ ), "\n" }