我的任务是使用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行，代码处理输出的时间太长。您建议进行哪些改进/更改，以便处理时间不会太长？
答案 0 :(得分：6)
您似乎正在尝试构建并精美打印有向图：
#!/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和计算transitive closure matrix的内存开销是否会在您的情况下过高。
答案 1 :(得分：5)
首先想到的是，尽管它与您的实际问题完全无关，但至少应该考虑让您的界面更灵活。如果您从<>读取并打印到STDOUT，您将能够从STDIN或命令行上给出的任意大小的文件列表中获取输入，而输出可以可以在控制台上查看，也可以重定向到一个文件中，只需对调用约定稍作修改：
parent_child_generator.pl input1.txt input2.txt input3.txt > output.txt
另一个小问题是$string=~s/\r?\n$//;中的trim是不必要的[1]。 $string=~s/\s+$//;会照顾它：
$ perl -e 'my $foo = "test\r\n"; print "--$foo--\n"; $foo =~ s/\s+$//; print "--$foo--\n";'
--test
--
--test--
解决您的性能问题（最后......），核心问题是您为connectByPrior [2]和@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是对的，但我很开心。）
修改：根据Sinan的评论，代码应该测试是否定义了$parent和$child，而不是它们是否属实。
[1]你通常应该使用chomp来删除换行符而不是正则表达式，但我会给你怀疑的好处，并假设你可能正在处理包含一种换行符的输入使用其他风格的环境。
[2] ...包含所有叶子节点，所以除非你有非常狭窄的深树，否则它将变得非常大，只有200k输入线。
[3] ...包含每个输入行，修剪了无关的空白。
答案 2 :(得分：0)
如果你知道你的ROOT节点叫什么，那么甚至可能是third way：）
use 5.012;
use warnings;
my $twigs = build_twigs_from( *DATA );
recurse_print( 'ROOT', $twigs->{ROOT} ); # explicit
sub build_twigs_from {
my $fh = shift;
my %twigs;
while (<$fh>) {
$twigs{ $+{parent} }->{ $+{child} } = $twigs{ $+{child} } //= {}
if m/ (?<parent> \S+) \s+ (?<child> \S+) /x;
}
return \%twigs;
}
sub recurse_print {
my ($path, $child) = @_;
# reached end of twig?
unless (%$child) {
say $path;
return;
}
recurse_print( $path . "\t$_", $child->{$_} )
for sort keys %$child;
}
__DATA__
S5 S3
S5 S8
ROOT S1
S1 S7
S2 S5
S3 S4
S1 S2
S4 77
S2 S9
S3 88
以上使用引用（在这种情况下为散列引用，但它也可以是数组引用或混合）来将所有节点（twigs）链接（即别名）在一起。这允许它为每个单元保持密钥平坦（在$ twigs hashref中），因此每个节点只是简单地引用回来。
如果您执行$twigs $VAR1 =
{
'S1' => {
'S2' => {
'S5' => {
'S8' => {},
'S3' => {
'88' => {},
'S4' => {
'77' => {}
}
}
},
'S9' => {}
},
'S7' => {}
},
'S9' => $VAR1->{'S1'}{'S2'}{'S9'},
'S4' => $VAR1->{'S1'}{'S2'}{'S5'}{'S3'}{'S4'},
'ROOT' => {
'S1' => $VAR1->{'S1'}
},
'S8' => $VAR1->{'S1'}{'S2'}{'S5'}{'S8'},
'88' => $VAR1->{'S1'}{'S2'}{'S5'}{'S3'}{'88'},
'77' => $VAR1->{'S1'}{'S2'}{'S5'}{'S3'}{'S4'}{'77'},
'S2' => $VAR1->{'S1'}{'S2'},
'S5' => $VAR1->{'S1'}{'S2'}{'S5'},
'S7' => $VAR1->{'S1'}{'S7'},
'S3' => $VAR1->{'S1'}{'S2'}{'S5'}{'S3'}
};
，您会看到：
ROOT这可能看起来有点胡言乱语，但是如果你遍历recurse_print()密钥，那么链接的哈希引用的完整层次结构将被公开（当涉及到空的hashref时，到达节点/ twig的末尾）。
$twigs->{ROOT}子例程打印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
的以下输出：
{{1}}
希望我没有遗漏任何东西，它确实可以处理您的200k数据（我很想知道这个解决方案的性能如何）。