Reputation: 8052
I am trying to convert following structure in perl (even elements are "parents" and odd are "childrens"):
$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'
];
to tree structure which will looks like this:
$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'
];
But after "for loop" I noticed that @arr has changed for unknown reasons, to this:
$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'
];
Can somebody please explain me why is this happening? Code which I am using for this is following (there is only one for loop for debug purposes). Maybe this is not optimal code, any recommendations are welcomed.
#!/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;
}
}
}
}
Thank you
Upvotes: 2
Views: 175
Reputation: 241988
Hash is a better structure for trees as the node names cannot be duplicate.
#!/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;
Output:
$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'
]
};
Upvotes: 2