how to translate an array of array elements (different lenghts) into a tree/hash
How can I convert programatically a list of arrays like this
$dat_a = [qw( a1 b1 c1 d1 e1)]
$dat_b = [qw( a1 b1 c2 d2 e1)]
$dat_c = [qw( a1 b2 c3)]
[...]
into a hierarchy (a hash) like
# {a1}--{b1}-{c1}-{d1}{e1}=42
# \ \{c2}-{d2}{e1}=84
# |{b2}-{c3}=72
Populating the hash like this with dinamically generated code:
$dat_hierarchy->{a1}{b1}{c1}{d1}{e1} ++
$dat_hierarchy->{a1}{b1}{c2}{d2}{e1} ++
$dat_hierarchy->{a1}{b2}{c3} ++
My problem here is that the arrays inside the run have different length, and that the maximum lenght is also varible between runs.
A similar problem would be to convert file paths to directory trees, so I asumme that there would be some standard algorithms for solving this problems.
If I hardcode the depth (or array lenght), a posible solution that I can think of, is to convert this problem to the more generic one of converting a matrix to a hierarchy. This imply converting the arrays to a matrix (adding trailing 0s to have all arrays with the same length). That way the solution would be trivial (if the script is hardocoded for the depth/length)
#[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]} ++
}
}
So, I would apreciate any suggestions about how to avoid hardcoding the maximum number of array index used in the hash creation,
A possible solution could be to use some metaprogramming to populate the hash using runtime $max_fixed_idx?. would it be something like the following a good idea?
sub populate_hash {
my ($array) = @_;
my $array_max_idx = @$array - 1;
# create hash_string " $dat_hierarchy->{$array->[0]}{$array->[1]}{$arra开发者_如何学编程y->[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';
}
What about recursion?
I would use something like 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;
}
If I understood your problem correctly, I'd do something akin to below.
The relevant bit in the solution below is $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);
This yields the following result:
$VAR1 = {
'a1' => {
'b1' => {
'c2' => {
'd2' => {
'e1' => {}
}
},
'c1' => {
'd1' => {
'e1' => {}
}
}
},
'b2' => {
'c3' => 16
}
}
};
I've seen similar problem discussed on perlmonks long time ago. I recollect shortest solution was something like this:
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;
Edit: Caution, the solution has serious security problems with string eval, see Schwern's comment below. I considered deletion, but decided to leave it here as warning to others.
精彩评论