如何将数组元素的数组不同长度转换为树/哈希

问题描述

| 我如何以编程方式转换这样的数组列表

$dat_a = [qw( a1 b1 c1 d1 e1)]
$dat_b = [qw( a1 b1 c2 d2 e1)]
$dat_c = [qw( a1 b2 c3)]
[...]

进入层次结构（哈希）

# {a1}--{b1}-{c1}-{d1}{e1}=42
#     \\     \\{c2}-{d2}{e1}=84
#      |{b2}-{c3}=72

像这样用动态生成的代码填充哈希：

$dat_hierarchy->{a1}{b1}{c1}{d1}{e1} ++
$dat_hierarchy->{a1}{b1}{c2}{d2}{e1} ++
$dat_hierarchy->{a1}{b2}{c3} ++

我的问题是运行中的数组不同 长度，并且最大长度在两次运行之间也是可变的。 类似的问题是将文件路径转换为目录树， 所以我认为会有一些标准算法可以解决 这个问题。 如果我对深度（或数组长度）进行硬编码，那么我可能的解决方案 可以想到的，就是将这个问题转换为更通用的 将矩阵转换为层次结构。这意味着转换数组 到矩阵（添加尾随0来使所有数组具有相同的 长度）。这样，解决方案将变得微不足道（如果脚本是 对深度/长度进行硬编码）

#[Perlish pseudocode]
$max_array_idx        = find_maximum_array_index (\\@list_of_arrays)
@lst_of_matrix_arrays = fill_to_same_length(\\@list_of_arrays,$max_array_idx)
$hierarchy            = create_tree(\\@list_of_matrix_arrays,$max_array_idx)

sub create_tree {
    my ($list_of_matrix_arrays,$max_array_idx) = @_;

    # <problem> how to dinamically handle $max_array_idx??

    # if I use fixed depth then is trivial
    # $max_fixed_idx = 2 
    # hardcoded hash construction for depth 3!

    # Trivial solution for fixed hash depth:
    foreach my $array ($list_of_matrix_arrays) {
        $dat_hierarchy->{$array->[0]}{$array->[1]}{$array->[2]} ++      
    }
}

因此，我将对如何避免硬编码提出任何建议 哈希创建中使用的最大数组索引数， 可能的解决方案是使用某些元编程通过运行时$ max_fixed_idx？填充哈希。 会是下面的一个好主意吗？

sub populate_hash {
    my ($array) = @_;
    my $array_max_idx =  @$array - 1;

    # create hash_string \" $dat_hierarchy->{$array->[0]}{$array->[1]}{$array->[2]} ++\"
    my $str = \'$dat_hierarchy->\';
    foreach my $idx (0..$array_max_idx) {
        # using the indexes instead the elements to avoid quotation problems
        $str .= \'{$array->[\'.$idx.\']}\';
        # how to sanitize the array element to avoid code injection in the further eval? what happen if an array element is called \"sub {system(\'rm -rf ~/\')}\" ;-)
        # http://xkcd.com/327/
    }
    $str .= \' ++\';

    # populate hash
    # $str for lengh 3 arrays would be \'$dat_hierarchy->{$array->[0]}{$array->[1]}{$array->[2]} ++\'
    eval($str) or die \'error creating the hash\';
}

递归呢？     

解决方法

如果我正确理解了您的问题，我会做以下类似的事情。 下面的解决方案中的相关位是

 $sub_hash = ($sub_hash->{$hash_key} ||= {});

#!/usr/bin/perl
use strict;
use warnings;

package HashBuilder;

  sub new {
    my $pkg = shift; 
    return bless {},$pkg;
  }

  sub add {
    my ($pkg,$data) = @_;
    my $sub_hash = $pkg;

    for my $idx (0..$#{$data}) {
      my $hash_key = $data->[$idx];
      $sub_hash = ($sub_hash->{$hash_key} ||= {});
    }
  }

  sub get_hash {
    my $pkg = shift;
    return %$pkg;
  }

package main;

use Data::Dumper;

my $dat_a = [qw( a1 b1 c1 d1 e1)];
my $dat_b = [qw( a1 b1 c2 d2 e1)];
my $dat_c = [qw( a1 b2 c3)];

my $builder = HashBuilder->new();
$builder->add($dat_a);
$builder->add($dat_c);
$builder->add($dat_b);

my %hash = $builder->get_hash();
$hash{a1}{b2}{c3} = 16;

print Dumper(\\%hash);

这将产生以下结果：

$VAR1 = {
          \'a1\' => {
                    \'b1\' => {
                              \'c2\' => {
                                        \'d2\' => {
                                                  \'e1\' => {}
                                                }
                                      },\'c1\' => {
                                        \'d1\' => {
                                                  \'e1\' => {}
                                                }
                                      }
                            },\'b2\' => {
                              \'c3\' => 16
                            }
                  }
        };

    ,我会使用类似Tree :: DAG_Node的东西。

use Tree::DAG_Node;
my $root = Tree::DAG_Node->new();

my $data = [qw( a1 b1 c1 d1 e1)];

my $node = $root;
for my $item (@$data) {
    my $daughter = Tree::DAG_Node->new();
    $daughter->name($item);
    $node->add_daughter($daughter);
    $node = $daughter;
}

    ,我很久以前就看到过有关perlmonks的类似问题。我记得最短的解决方案是这样的：

use strict; use warnings;

my @items = (
    [qw( a1 b1 c1 d1 e1)],[qw( a1 b1 c2 d2 e1)],[qw( a1 b2 c3)],);

my $dat_hierarchy;
for my $item (@items) {
    eval \"\\$dat_hierarchy->{\'\" . join(\"\'}{\'\",@$item) . \"\'}++\";
}

use Data::Dump;
dd $dat_hierarchy;

编辑：警告，该解决方案具有字符串eval的严重安全问题，请参阅下面的Schwern \评论。我考虑过删除，但决定将其留在此处以警告他人。