2

私はperlで次の構造を変換しようとしています(要素は「親」で、奇数は「子」です):

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

次のようなツリー構造に変換します。

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

しかし、「for ループ」の後、@arr が不明な理由で次のように変更されていることに気付きました。

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

誰かがなぜこれが起こっているのか説明してもらえますか? これに使用しているコードは次のとおりです (デバッグ用のループは 1 つだけです)。これは最適なコードではないかもしれませんが、推奨事項は歓迎します。

#!/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;
      }
    }
  }
}

ありがとうございました

4

1 に答える 1

2

ノード名は重複できないため、ハッシュはツリーのより良い構造です。

#!/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;

出力：

$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'
                   ]
        };
于 2013-05-30T12:57:05.223 に答える