在perl中解析树数据文件答案

【问题标题】：Parsing Tree data file in perl在perl中解析树数据文件
【发布时间】：2013-12-20 18:34:39
【问题描述】：

我是 Perl 的新手。我有一个文件，其中包含树格式的数据，如下所示。我需要解析大数据并从中生成 .TSV 文件。文件格式为

A 
|
|--B 
|  |
|  |--C
|     | 
|     |---PQR
|     |---XYZ
|--D
|  |
|  |---LMN
|---XYZ

我需要的输出是制表符分隔格式。

Coloum1     Coloum2     Coloum3     Coloum4 
A           B           C           PQR
A           B           C           XYZ
A           D                       LMN
A                                   XYZ

我编写了一个不适用于中间节点的代码。这里是 B 节点，它没有叶节点，连接到根节点的叶节点没有正确进入输出。我正在从命令行读取输入文件。

#!/usr/bin/perl
use Data::Dumper;
open (MYFILE, "<", $ARGV[0]);

my $content = "";
while(<MYFILE>)
{
    my $line = $_;
    $content = $content.$line;
}

my ($root, @block) = split(/\|--(\w)/, $content);

$root =~ s/.*?(\w+).*/$1/is;
my %block = @block;

print "\nColoum1\tColumn2\tColumn3\tColumn4";
foreach my $key( keys %block)
{
    my $content =  $block{$key};
    my (undef, @lines) = split(/\n/, $content);
    foreach my $line (@lines)
    {
        if($line =~ /---(\w+)/is)
        {
            my $val = $1;

            if(defined $val)
            {
                print "\n$root\t$key\t$val";
            }
        }
    }
}

我从中得到的输出是

Coloum1     Column2     Column3     Column4
A           D       LMN
A           D       XYZ
A           C       PQR
A           C       XYZ

这是我在这段代码中缺少的东西。你能指导我解决我的问题吗？

是否有任何 CPAN 库可以帮助我处理此类问题。

【问题讨论】：

你能更详细地描述一下输入格式吗？为什么LMN 行的开头没有竖线？破折号的数量是否重要（2 - 内部节点，3 - 叶）？为什么B下面的竖条向右移动了？
是的，您是对的，LMN 行的开头有竖线。并且破折号的数量表示内部节点的（2-）和叶节点的（3-）。它的竖线错字。我还修改了我的输入。
我已准备好代码，但由于问题被搁置，因此无法在此处发布。请尝试改进它。
@choroba ：我刚刚修改了我的问题并添加了我为解决问题所做的努力，但它不起作用。需要你的帮助
youtube.com/watch?v=_CichAlmpmA

标签： perl tree tsv

【解决方案1】：

我的尝试：

#!/usr/bin/perl
use warnings;
use strict;

use Test::More tests => 1;

my $input = 'A 
|
|--B 
|  |
|  |--C
|     | 
|     |---PQR
|     |---XYZ
|--D
|  |
|  |---LMN
|---XYZ
';

open my $IN, '<', \$input or die $!;

my @path;
my @output;
my $size = 0;

while (<$IN>) {
    if (!/\|/) {                        # Root.
        @path = [0, /(\S+)/];

    } elsif (/\|(?=-)/g) {              # Capture the position of the last |.

        if ($path[-1][0] == pos) {      # Sibling.
            ($path[-1][1]) = /-+(\S+)/;

        } elsif ( $path[-1][0] < pos) { # Child.
            push @path, [pos, /-+(\S+)/];

        } else {                        # New branch.
            pop @path until $path[-1][0] == pos;
            $path[-1] = [pos, /-+(\S+)/];
        }

        if (/---/) {
            push @output, [ map $_->[1], @path ];
            $size = @path if @path > $size;
        }
    }
}

my $expected = 'Column1 Column2 Column3 Column4
A   B   C   PQR
A   B   C   XYZ
A   D       LMN
A           XYZ
';

my $output = join "\t", map "Column$_", 1 .. $size;

for my $row (@output) {
    $output .= "\n";
    $output .= join "\t", @{$row}[0 .. $#{$row} - 1],
                          (q()) x ($size - @$row),
                          $row->[-1];
}
$output .= "\n";

is($output, $expected);

【讨论】：