Question

所以，我有下一个哈希数组：

my @arr = (
  #subways, "0" - superroot
  {id => "1",     parent_id => "0",     name => "subway 1"},
  #lines
  {id => "12642", parent_id => "1",     name => "no category"},
  {id => "12645", parent_id => "1",     name => "line 1"},
  #cars
  {id => "12646", parent_id => "1",     name => "carriage 1"},
  {id => "12646", parent_id => "12645", name => "carriage 1"},
  {id => "12647", parent_id => "1",     name => "carriage 2"},
  {id => "12647", parent_id => "12645", name => "carriage 2"},
  {id => "12679", parent_id => "1",     name => "separate cars"},
  {id => "12679", parent_id => "12642", name => "separate cars"},
  {id => "12643", parent_id => "1",     name => "ungrouped"},
  {id => "12643", parent_id => "12642", name => "ungrouped"}
);

我注意像他们一样做一棵树：

subway->line->carriage

顺便说一句，这是一个问题。如你所见 - 这里是加倍车厢中的“1”，但我需要行作为parent_id。有没有办法做到这一点？

Answer 1

use strict;
use warnings qw( all );
use feature qw( current_sub say );

my @rows = (
   #subways, "0" - superroot
   {id => "1",     parent_id => "0",     name => "subway 1"},
   #lines
   {id => "12642", parent_id => "1",     name => "no category"},
   {id => "12645", parent_id => "1",     name => "line 1"},
   #cars
   {id => "12646", parent_id => "1",     name => "carriage 1"},
   {id => "12646", parent_id => "12645", name => "carriage 1"},
   {id => "12647", parent_id => "1",     name => "carriage 2"},
   {id => "12647", parent_id => "12645", name => "carriage 2"},
   {id => "12679", parent_id => "1",     name => "separate cars"},
   {id => "12679", parent_id => "12642", name => "separate cars"},
   {id => "12643", parent_id => "1",     name => "ungrouped"},
   {id => "12643", parent_id => "12642", name => "ungrouped"}
);

my $tree = { name => "[root]", children => [] };
{
   my %tree = ( 0 => $tree );

   for my $row (@rows) {
      my $node = $tree{ $row->{id} } //= { name => undef, children => [] };
      $node->{name} = $row->{name};

      my $parent_node = $tree{ $row->{parent_id} } //= { name => undef, children => [] };
      push @{ $parent_node->{children} }, $node;
   }
}

# Add depth to nodes.
# use a breadth-first search so that the depth of nodes
# at multiple depths are set to the node's deepest depth.
{
   my @todo = ( [ $tree, 0 ] );
   while (@todo) {
      my ($node, $depth) = @{ shift(@todo) };
      $node->{depth} = $depth;

      ++$depth;
      push @todo, map { [ $_, $depth ] } @{ $node->{children} };
   }
}

# Trim shortcuts to deeper nodes.
{
   my @todo = $tree;
   while (@todo) {
      my $node = shift(@todo);
      my $depth = delete($node->{depth}) + 1;
      @{ $node->{children} } = grep { $_->{depth} == $depth } @{ $node->{children} };
      push @todo, @{ $node->{children} };
   }
}

# Display tree
for my $subway (@{ $tree->{children} }) {
   say $subway->{name};
   for my $line (@{ $subway->{children} }) {
      say "  ", $line->{name};
      for my $car (@{ $line->{children} }) {
         say "    ", $car->{name};
      }
   }
}

输出：

subway 1
  no category
    separate cars
    ungrouped
  line 1
    carriage 1
    carriage 2

Answer 2

更新

道歉。我错过了你的最后一段，解释了一个项目可能有一个虚假的父母＆＃34; 1＆＃34;除了真正的价值。我已经添加了一些代码来清理原始数据，并在构建图形之前为其真正的父项创建每个节点的地图use strict; use warnings 'all'; use Graph::Directed; my @arr = ( #subways, "0" - superroot { id => "1", parent_id => "0", name => "subway 1" }, #lines { id => "12642", parent_id => "1", name => "no category" }, { id => "12645", parent_id => "1", name => "line 1" }, #cars { id => "12646", parent_id => "1", name => "carriage 1" }, { id => "12646", parent_id => "12645", name => "carriage 1" }, { id => "12647", parent_id => "1", name => "carriage 2" }, { id => "12647", parent_id => "12645", name => "carriage 2" }, { id => "12679", parent_id => "1", name => "separate cars" }, { id => "12679", parent_id => "12642", name => "separate cars" }, { id => "12643", parent_id => "1", name => "ungrouped" }, { id => "12643", parent_id => "12642", name => "ungrouped" } ); # Sanitise data to remove "1" parents # my %parent; for my $node ( @arr ) { my ($id, $parent_id) = @{$node}{qw/ id parent_id /}; next unless $parent_id; $parent{$id} = $parent_id unless $parent{$id} and $parent{$id} ne 1; } # Build the graph # my $tree = Graph::Directed->new; for my $node ( keys %parent ) { $tree->add_edge( $parent{$node} => $node ); } # Display the data # my %names = map { @{$_}{qw/ id name /} } @arr; print_tree($tree, $_) for $tree->predecessorless_vertices; sub print_tree { my ($tree, $root, $indent) = @_; $indent //= 0; printf "%s%s\n", ' ' x $indent, $names{$root}; print_tree($tree, $_, $indent + 1) for $tree->successors($root); }

subway 1
    line 1
        carriage 1
        carriage 2
    no category
        separate cars
        ungrouped

输出

print_tree

原始答案

我建议您使用Graph模块。树是定向图形，您需要做的就是创建图形，添加连接（＆＃34;边缘＆＃34;）并询问结果

这个程序就是这样做的。我编写了一个predecessorless_vertices子程序，它以给定起点的缩进行显示树。对use strict; use warnings 'all'; use Graph::Directed; my @arr = ( #subways, "0" - superroot { id => "1", parent_id => "0", name => "subway 1" }, #lines { id => "12642", parent_id => "1", name => "no category" }, { id => "12645", parent_id => "1", name => "line 1" }, #cars { id => "12646", parent_id => "1", name => "carriage 1" }, { id => "12646", parent_id => "12645", name => "carriage 1" }, { id => "12647", parent_id => "1", name => "carriage 2" }, { id => "12647", parent_id => "12645", name => "carriage 2" }, { id => "12679", parent_id => "1", name => "separate cars" }, { id => "12679", parent_id => "12642", name => "separate cars" }, { id => "12643", parent_id => "1", name => "ungrouped" }, { id => "12643", parent_id => "12642", name => "ungrouped" } ); # Build the graph # my $tree = Graph::Directed->new; for my $node ( @arr ) { $tree->add_edge( @{$node}{qw/ parent_id id /} ) if $node->{parent_id}; } # Display the structure # my %names = map { @{$_}{qw/ id name /} } @arr; print_tree($tree, $_) for $tree->predecessorless_vertices; sub print_tree { my ($tree, $root, $indent) = @_; $indent //= 0; printf "%s%s\n", ' ' x $indent, $names{$root}; print_tree($tree, $_, $indent + 1) for $tree->successors($root); }的调用会查找树的所有根：没有其他节点连接到的节点。在这种情况下，只有一个根，因为应该有

subway 1
    no category
        ungrouped
        separate cars
    carriage 2
    carriage 1
    separate cars
    ungrouped
    line 1
        carriage 2
        carriage 1

输出

{{1}}

Perl，从哈希数组中创建哈希树的哈希值

2 个答案:

更新

输出

原始答案

输出