使用perl创建层次结构文件

Question

我的任务是使用perl创建父子层次结构文件.

示例输入文件(制表符分隔).记录将以随机顺序排列在文件中,"父"可以出现在"子"之后.

 S5 S3
 S5 S8
 ROOT   S1
 S1 S7
 S2 S5
 S3 S4
 S1 S2
 S4 77
 S2 S9
 S3 88

示例输出文件(制表符分隔)

ROOT    S1  S2  S5  S3  S4  77
ROOT    S1  S2  S5  S3  88
ROOT    S1  S7
ROOT    S1  S2  S5  S8
ROOT    S1  S2  S9

生成上述输出文件的代码

use strict;

# usage: perl parent_child_generator.pl input.txt output.txt

my $input0=$ARGV[0] or die "must provide input.txt as the first argument\n";
my $output1=$ARGV[1] or die "must provide output.txt as the second argument\n";

open(IN0,"<",$input0) || die "Cannot open $input0 for reading: $!";
open(OUT1,">",$output1) || die "Cannot open $output1 for writing: $!";

sub trim
{
    my $string=shift;
$string=~s/\r?\n$//;
$string=~s/^\s+//;
$string=~s/\s+$//;
return $string;
}

sub connectByPrior
{
my $in_child=$_[0];
my %in_hash=%{$_[1]};
my @anscestor_arr;

for (sort keys %in_hash)
{
    my $key=$_;
    my @key_arr=split(/\t/,$key);
    my $parent=$key_arr[0];
    my $child=$key_arr[1];

    if ($in_child eq $child)
    {
        push (@anscestor_arr,$parent);
        @anscestor_arr=(@{connectByPrior($parent,\%in_hash)},@anscestor_arr);
        last;
    }
}
return \@anscestor_arr;
}

my %parent_hash;
my %child_hash;
my %unsorted_hash;
while(<IN0>)
{
my @cols=split(/\t/);
for (my $i=0; $i < scalar(@cols); $i++)
{
    $cols[$i]= trim($cols[$i]);
}

my $parent=$cols[0];
my $child=$cols[1];
my $parent_child="$parent\t$child";

$parent_hash{$parent}=1;
$child_hash{$child}=1;
$unsorted_hash{$parent_child}=1;
 }
 close(IN0);

my @lev0_arr;
for (sort keys %child_hash)
{
my $rec=$_;
if (!exists($parent_hash{$rec}))
{
    push (@lev0_arr,$rec);
}
}

for (@lev0_arr)
{
my $child=$_;
my @anscestor_arr=@{connectByPrior($child,\%unsorted_hash)};
push (@anscestor_arr,$child);
print OUT1 join("\t",@anscestor_arr)."\n";
}

问题:如果输入文件不是太大,代码工作正常.实际的输入文件包含超过200k行,代码处理输出的时间太长.您建议进行哪些改进/更改,以便处理时间不会太长？

Answer 1

您似乎正在尝试构建并精美打印有向图:

#!/usr/bin/perl

use strict; use warnings;
use Graph::Directed;
use Graph::TransitiveClosure::Matrix;

 my $g = Graph::Directed->new;

while ( my $line = <DATA> ) {
    next unless my ($x, $y) = split ' ', $line;
    $g->add_edge($x, $y);
}

my @start = $g->source_vertices;
my @end   = $g->sink_vertices;

my $tcm = Graph::TransitiveClosure::Matrix->new( $g,
    path_vertices => 1,
);

for my $s ( @start ) {
    for my $e ( @end ) {
        next unless $tcm->is_reachable($s, $e);
        print join("\t", $tcm->path_vertices($s, $e)), "\n";
    }
}

__DATA__
S5 S3
S5 S8
ROOT   S1
S1 S7
S2 S5
S3 S4
S1 S2
S4 77
S2 S9
S3 88

输出:

ROOT    S1      S2      S9
ROOT    S1      S2      S5      S8
ROOT    S1      S2      S5      S3      S4      77
ROOT    S1      S2      S5      S3      88
ROOT    S1      S7

我不确定使用Graph和计算传递闭包矩阵的内存开销是否会在您的情况下过高.

Answer 2

我想到的,虽然这是完全无关,您的实际问题的第一件事,就是你至少应该考虑让你的界面更加灵活.如果从阅读<>和打印到STDOUT,你就可以把从任一输入STDIN的命令行给出的文件或任意大小的列表,而输出则可以在控制台上,只有轻微查看或重定向到一个文件调用约定的变化:

parent_child_generator.pl input1.txt input2.txt input3.txt > output.txt

另一个小问题是$string=~s/\r?\n$//;in trim是不必要的[1]. $string=~s/\s+$//;会照顾它:

$ perl -e 'my $foo = "test\r\n"; print "--$foo--\n"; $foo =~ s/\s+$//; print "--$foo--\n";'
--test
--
--test--

解决你的性能问题(最后......),核心问题是你要调用[2]中的connectByPrior每个元素,@lev0_arr而connectByPrior不是每次调用它时都会循环%unsorted_hash[3],但是,在该循环中,它调用自身递归!在第一个近似值,它在O(n ^ 2 log n)和O(n ^ 3)之间,取决于树木的形状,这简直太可怕了.您需要避免为收到的每个其他数据多次触摸每个数据.

那么,我该怎么做呢？我的第一个想法是使用一个哈希来跟踪我的根节点(所有那些没有链接到它们的节点)和一个散列哈希(HoH)以跟踪所有链接.当看到每个输入行时,将其拆分为父级和子级,就像您正在做的那样.如果父级在链接HoH中还没有条目,请将其添加到根哈希中.如果子项位于根哈希中,请将其删除.如果孩子不在链接HoH中,为它添加一个空的hashref(所以我们将来会知道它不是root).最后,在链接HoH中添加一个条目,指示父级链接到子级.

然后输出只是迭代根哈希(您的起始点列表),并且对于在那里找到的每个节点,递归地打印该节点的子节点.

像这样:

#!/usr/bin/perl

use strict;
use warnings;
use 5.010;

my %root;
my %link;

while (<>) {
  my ($parent, $child) = split /\t/, $_, 2;
  next unless defined $parent and defined $child;
  $_ = trim($_) for ($parent, $child);

  $root{$parent} = 1 unless exists $link{$parent};
  delete $root{$child};
  $link{$child} ||= {};
  $link{$parent}{$child} = 1;
}

print_links($_) for sort keys %root;

exit;

sub trim {
  my $string=shift;
  $string=~s/^\s+//;
  $string=~s/\s+$//;
  return $string;
}

sub print_links {
  my @path = @_;

  my %children = %{$link{$path[-1]}};
  if (%children) {
    print_links(@path, $_) for sort keys %children;
  } else {
    say join "\t", @path;
  }
}

给出您的示例输入,这将产生输出:

ROOT    S1      S2      S5      S3      88
ROOT    S1      S2      S5      S3      S4      77
ROOT    S1      S2      S5      S8
ROOT    S1      S2      S9
ROOT    S1      S7

由于此版本仅触摸每个链接一次用于输入,一次触摸输出,因此随着输入数据量的增加,它应该或多或少地线性扩展.

(当然,如果你真的想要完成任务,思南建议你去CPAN是正确的,但我很开心.)

编辑:代码应该测试是否$parent和$child定义,它们不是是否是真实的,每思南的评论.

[1]你通常应该使用chomp删除换行符而不是正则表达式,但我给你怀疑的好处,并假设你可能在使用其他样式的环境中处理包含一种换行方式的输入.

[2] ...包含所有叶子节点,因此除非你有非常狭窄的深树,否则它将变得非常大,有200k输入线.

[3] ...包含每个输入行,修剪了无关的空白.