как перевести массив элементов массива (разных длин) в дерево / хэш - PullRequest
2 голосов
/ 13 апреля 2011

Как я могу программно преобразовать список массивов, подобных этому

$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';
}

А как насчет рекурсии?

Ответы [ 3 ]

5 голосов
/ 13 апреля 2011

Я бы использовал что-то вроде 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;
}
3 голосов
/ 13 апреля 2011

Если бы я правильно понял вашу проблему, я бы сделал что-то похожее на приведенное ниже.

Соответствующий бит в приведенном ниже решении: $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
                            }
                  }
        };
1 голос
/ 13 апреля 2011

Я уже видел подобную проблему, обсуждаемую на 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, см. Комментарий Шверна ниже. Я рассмотрел удаление, но решил оставить его здесь как предупреждение для других.

...