Perl - Convertir un tableau en arbre OU pourquoi les variables changent arbitrairement

Question

J'essaie de convertir la structure suivante en perl (les éléments pairs sont les "parents" et les impairs les "enfants") :

$VAR1 = 'ng1';
$VAR2 = [
          'ng1_1',
          'ng1_2',
          'ng1_3',
          'ng1_4'
        ];
$VAR3 = 'ng2';
$VAR4 = [
          'ng2_1',
          'ng2_2',
          'ng2_3',
          'ng2_4'
        ];
$VAR5 = 'ng3';
$VAR6 = [
          'ng3_1',
          'ng3_2',
          'ng3_3',
          'ng3_4'
        ];
$VAR7 = 'ng1_1';
$VAR8 = [
          'ng1_1_1',
          'ng1_1_2',
          'ng1_1_3',
          'ng1_1_4'
        ];
$VAR9 = 'ng1_1_1';
$VAR10 = [
           'ng1_1_1_u1',
           'ng1_1_1_u2',
           'ng1_1_1_u3'
         ];
$VAR11 = 'ng2_1';
$VAR12 = [
           'ng2_1_u1',
           'ng2_1_u2',
           'ng2_1_u3'
         ];

à une structure arborescente qui ressemblera à ceci :

$VAR1 = 'ng1';
$VAR2 = [
          'ng1_1',
          [
            'ng1_1_1',
            [
              'ng1_1_1_u1',
              'ng1_1_1_u2',
              'ng1_1_1_u3'
            ],
            'ng1_1_2',
            'ng1_1_3',
            'ng1_1_4'
          ],
          'ng1_2',
          'ng1_3',
          'ng1_4'
        ];
$VAR3 = 'ng2';
$VAR4 = [
          'ng2_1',
          [
            'ng2_1_u1',
            'ng2_1_u2',
            'ng2_1_u3'
          ],
          'ng2_2',
          'ng2_3',
          'ng2_4'
        ];
$VAR3 = 'ng3';
$VAR4 = [
          'ng3_1',
          'ng3_2',
          'ng3_3',
          'ng3_4'
        ];

Mais après la "boucle for", j'ai remarqué que @arr a changé, pour des raisons inconnues, en ceci :

$VAR1 = 'ng1';
$VAR2 = [
          'ng1_1',
          [
            'ng1_1_1',
            [
              'ng1_1_1_u1',
              'ng1_1_1_u2',
              'ng1_1_1_u3'
            ],
            'ng1_1_2',
            'ng1_1_3',
            'ng1_1_4'
          ],
          'ng1_2',
          'ng1_3',
          'ng1_4'
        ];
$VAR3 = 'ng2';
$VAR4 = [
          'ng2_1',
          'ng2_2',
          'ng2_3',
          'ng2_4'
        ];
$VAR5 = 'ng3';
$VAR6 = [
          'ng3_1',
          'ng3_2',
          'ng3_3',
          'ng3_4'
        ];
$VAR7 = 'ng1_1';
$VAR8 = $VAR2->[1];
$VAR9 = 'ng1_1_1';
$VAR10 = $VAR2->[1][1];
$VAR11 = 'ng2_1';
$VAR12 = [
           'ng2_1_u1',
           'ng2_1_u2',
           'ng2_1_u3'
         ];

Quelqu'un peut-il m'expliquer pourquoi cela se produit ? Le code que j'utilise pour cela est le suivant (il n'y a qu'une boucle for à des fins de débogage). Peut-être que ce code n'est pas optimal, toute recommandation est la bienvenue.

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

my @arr = (
        'ng1',     ['ng1_1','ng1_2', 'ng1_3', 'ng1_4'],
        'ng2',     ['ng2_1','ng2_2', 'ng2_3', 'ng2_4'],
        'ng3',     ['ng3_1','ng3_2', 'ng3_3', 'ng3_4'],
        'ng1_1',   ['ng1_1_1','ng1_1_2', 'ng1_1_3', 'ng1_1_4'],
        'ng1_1_1', ['ng1_1_1_u1', 'ng1_1_1_u2', 'ng1_1_1_u3'],
        'ng2_1',   ['ng2_1_u1', 'ng2_1_u2', 'ng2_1_u3']
);

my @tree;

#print "\nBEFORE CALLING FIRST FOR LOOP\n";
#print Dumper @arr;

$tree[0] = $arr[0];
$tree[1] = $arr[1];
for (my $i=2; $i < @arr; $i+=2){
  &buildTree(\@tree, $arr[$i], $arr[$i+1]);
}

#print "\nAFTER CALLING FIRST FOR LOOP\n";
#print Dumper @arr;

#$tree[2] = $arr[2];
#$tree[3] = $arr[3];
#for (my $i=4; $i < @arr; $i+=2){
#  &buildTree(\@tree, $arr[$i], $arr[$i+1]);
#}

sub buildTree{
  my ($tree, $parNg, $subNg) = @_;
  for my $treeElement (@{$tree}){
    if (ref $treeElement eq "ARRAY"){
      &buildTree($treeElement, $parNg, $subNg);
    }
    else{
      if ($treeElement eq $parNg){
        my ($index) = grep { $tree->[$_] eq $treeElement } 0..scalar(@$tree)-1;
        splice @{$tree}, $index + 1, 0, $subNg;
      }
    }
  }
}

Merci.

Answer 1

Le hachage est une meilleure structure pour les arbres car les noms des nœuds ne peuvent pas être dupliqués.

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

use Data::Dumper;

my %tree = (
            ng1     => ['ng1_1'      , 'ng1_2'      , 'ng1_3'     , 'ng1_4'  ],
            ng2     => ['ng2_1'      , 'ng2_2'      , 'ng2_3'     , 'ng2_4'  ],
            ng3     => ['ng3_1'      , 'ng3_2'      , 'ng3_3'     , 'ng3_4'  ],
            ng1_1   => ['ng1_1_1'    , 'ng1_1_2'    , 'ng1_1_3'   , 'ng1_1_4'],
            ng1_1_1 => ['ng1_1_1_u1' ,  'ng1_1_1_u2', 'ng1_1_1_u3'           ],
            ng2_1   => ['ng2_1_u1'   ,  'ng2_1_u2'  , 'ng2_1_u3'             ],
           );

my $change = 1;
while ($change) {
    undef $change;

    for my $remove (keys %tree) {
        my @nonleaves = grep exists $tree{$_}, @{ $tree{$remove} };

        if (not @nonleaves) {
            my ($parent) = grep { grep $_ eq $remove, @{ $tree{$_} } } keys %tree;
            next unless $parent;

            $_ eq $remove and $_ = { $remove => $tree{$remove} } for @{ $tree{$parent} };
            delete $tree{$remove};
            $change = 1;
        }
    }
}

print Dumper \%tree;

Sortie :

$VAR1 = {
          'ng1' => [
                     {
                       'ng1_1' => [
                                    {
                                      'ng1_1_1' => [
                                                     'ng1_1_1_u1',
                                                     'ng1_1_1_u2',
                                                     'ng1_1_1_u3'
                                                   ]
                                    },
                                    'ng1_1_2',
                                    'ng1_1_3',
                                    'ng1_1_4'
                                  ]
                     },
                     'ng1_2',
                     'ng1_3',
                     'ng1_4'
                   ],
          'ng3' => [
                     'ng3_1',
                     'ng3_2',
                     'ng3_3',
                     'ng3_4'
                   ],
          'ng2' => [
                     {
                       'ng2_1' => [
                                    'ng2_1_u1',
                                    'ng2_1_u2',
                                    'ng2_1_u3'
                                  ]
                     },
                     'ng2_2',
                     'ng2_3',
                     'ng2_4'
                   ]
        };