реорганизация файла особым образом [Perl]

Question

Рассмотрим следующий файл:

5,*,ABC
6,5,XYZ
7,5,123
4,6,xyz
1,4,xox
8,6,yoy

Формат каждой строки: (* не имеет родителя)

pid,parent-pid,name

Я хотел бы как-нибудь создать следующий файл:

ABC,
ABC,XYZ
ABC,123
ABC,XYZ,xyz
ABC,XYZ,xyz,xyx
ABC,XYZ,yoy

Значение для каждого PID, я могу перейти к его старшему родителю в той же строке.Я думал реализовать его (в Perl) с помощью хэша, вставив его в хэш.Проблема в том, что я не знаю, какой будет длина каждой строки, а затем длина хеша.Кроме того, я ищу наиболее эффективный из возможных способов.

Какой хороший алгоритм решит эту проблему?

Answer 1

Я бы справился с этим, сохранив массив родительских отношений и затем просматривая этот массив при каждом чтении строки:

my @parent;

open my $IN, '<', 'file' or die;
while (<$IN>) {
  chomp;
  my ($id, $parent, $name) = split /,/;
  $parent[$id] = [ $parent, $name ];

  if ($parent eq '*') {
    print $name;
  } else {
    my @output = ( [ $parent, $name ] );

    while (my $p = $parent[${$output[0]}[0]]) {
      unshift @output, $p;
    }

    print join ',', map { ${$_}[1] } @output;
  }

  print "\n";
}
close $IN;

Вывод:

ABC
ABC,XYZ
ABC,123
ABC,XYZ,xyz
ABC,XYZ,xyz,xox
ABC,XYZ,yoy

-РЕДАКТИРОВАТЬ - Для обратной связи, пересмотрено, чтобы использовать хэши и не зависеть от порядка файлов:

my %parent;

open my $IN, '<', 'file' or die;
while (<$IN>) {
  chomp;
  my ($id, $parent, $name) = split /,/;
  $parent{$id} = [ $parent, $name ];
}

seek $IN, 0, 0;
while (<$IN>) {
  chomp;
  my ($id, $parent, $name) = split /,/;

  if ($parent eq '*') {
    print $name;
  } else {
    my @output = ( [ $parent, $name ] );

    while (my $p = $parent{${$output[0]}[0]}) {
      unshift @output, $p;
    }

    print join ',', map { ${$_}[1] } @output;
  }

  print "\n";
}
close $IN;

Answer 2

Вы можете создать хеш pids с ключом родительского pid.

use feature qw( current_sub );

use Text::CSV_XS qw( );

my $csv = Text::CSV_XS->new({ binary => 1, auto_diag => 2 });

my %process_children_by_pid;
my %process_name_by_pid;
while (my $row = $csv->getline(*STDIN)) {
   my ($pid, $parent, $name) = @$row;
   $process_name_by_pid{$pid} = $name;
   push @{ $processes_children_by_pid{$parent} }, $pid;
}

sub {
   my $pid = pop;
   push @_, $process_name_by_pid{$pid};
   $csv->say(*STDOUT, \@_);
   __SUB__->(@_, $_) for @{ $processes_children_by_pid{$pid} };
}->($_) for @{ $processes_children_by_pid{'*'} };

Или вы можете использовать Graph.pm.Это увеличивает накладные расходы, но облегчает проверку ошибок.

use feature qw( current_sub );

use Graph        qw( );
use Text::CSV_XS qw( );

my $csv = Text::CSV_XS->new({ binary => 1, auto_diag => 2 });

my $tree = Graph->new();
my %process_name_by_pid;
while (my $row = $csv->getline(*STDIN)) {
   my ($pid, $parent, $name) = @$row;
   $process_name_by_pid{$pid} = $name;
   $tree->add_edge($parent, $pid);
}

die "Bad data" if $tree->has_a_cycle;

my @roots = $tree->predecessorless_vertices();
die "Bad data" if @roots != 1 || $roots[0] ne '*';

sub {
   my $pid = pop;
   push @_, $process_name_by_pid{$pid};
   $csv->say(*STDOUT, \@_);
   __SUB__->(@_, $_) for $tree->successors($pid);
}->($_) for $tree->successors('*');