Первое, что приходит на ум, хотя это совершенно не связано с вашим реальным вопросом, это то, что вы должны хотя бы рассмотреть возможность сделать свой интерфейс более гибким.Если вы прочитаете из <> и напечатаете в 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 для каждого элемента в @lev0_arr [2] и connectByPrior не только зацикливается на %unsorted_hash [3] при каждом вызове, но и внутри этого цикла вызывает себя рекурсивно!В первом приближении это где-то между O (n ^ 2 log n) и O (n ^ 3), в зависимости от формы ваших деревьев, что просто ужасно.Вы должны избегать касания каждого фрагмента данных несколько раз для каждого другого фрагмента данных, которые вы получаете.
Итак, как бы я поступил так?Моя первая мысль - использовать один хеш для отслеживания моих корневых узлов (все те, которые не имеют к ним никаких ссылок) и один хеш (HoH) для отслеживания всех ссылок.Когда каждая строка ввода видна, разделите ее на родительский и дочерний, как вы делаете.Если у родителя еще нет записи в ссылке HoH, добавьте ее в корневой хэш.Если ребенок находится в корневом хеше, удалите его.Если дочерний элемент отсутствует в ссылках HoH, добавьте для него пустой хэш-код (так что в будущем мы узнаем, что это не 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, а не являются ли ониtrue, согласно комментарию Синан.
[1] Обычно вы должны использовать chomp, чтобы удалить переносы строк вместо регулярных выражений, но я даю вам преимущество сомнения и предполагаю, что вы, возможно, обрабатываете вводсодержащий один стиль разрывов строк в среде, которая использует другой стиль.
[2] ... который содержит все конечные узлы, поэтому он будет довольно большим с 200k входными строками, если у вас нет слишком узких, глубокие деревья.
[3] ... который содержит каждую строку ввода, обрезанную от посторонних пробелов.