6

Perlでは、これを取得するにはどうすればよいですか:

$VAR1 = { '999' => { '998' => [ '908', '906', '0', '998', '907' ] } }; 
$VAR1 = { '999' => { '991' => [ '913', '920', '918', '998', '916', '919', '917', '915', '912', '914' ] } }; 
$VAR1 = { '999' => { '996' => [] } }; 
$VAR1 = { '999' => { '995' => [] } }; 
$VAR1 = { '999' => { '994' => [] } }; 
$VAR1 = { '999' => { '993' => [] } }; 
$VAR1 = { '999' => { '997' => [ '986', '987', '990', '984', '989', '988' ] } }; 
$VAR1 = { '995' => { '101' => [] } }; 
$VAR1 = { '995' => { '102' => [] } }; 
$VAR1 = { '995' => { '103' => [] } }; 
$VAR1 = { '995' => { '104' => [] } }; 
$VAR1 = { '995' => { '105' => [] } }; 
$VAR1 = { '995' => { '106' => [] } }; 
$VAR1 = { '995' => { '107' => [] } }; 
$VAR1 = { '994' => { '910' => [] } }; 
$VAR1 = { '993' => { '909' => [] } }; 
$VAR1 = { '993' => { '904' => [] } }; 
$VAR1 = { '994' => { '985' => [] } }; 
$VAR1 = { '994' => { '983' => [] } }; 
$VAR1 = { '993' => { '902' => [] } }; 
$VAR1 = { '999' => { '992' => [ '905' ] } };

これに：

$VAR1 = { '999:' => [
 { '992' => [ '905' ] },
 { '993' => [
  { '909' => [] },
  { '904' => [] },
  { '902' => [] }
 ] },
 { '994' => [
  { '910' => [] },
  { '985' => [] },
  { '983' => [] }
 ] },
 { '995' => [
  { '101' => [] },
  { '102' => [] },
  { '103' => [] },
  { '104' => [] },
  { '105' => [] },
  { '106' => [] },
  { '107' => [] }
 ] },
 { '996' => [] },
 { '997' => [ '986', '987', '990', '984', '989', '988' ] },
 { '998' => [ '908', '906', '0', '998', '907' ] },
 { '991' => [ '913', '920', '918', '998', '916', '919', '917', '915', '912', '914' ] }
]};
4

7 に答える 7

4

これは他の誰よりも近いと思います：

これは、あなたが望むことのほとんどを行います。私はそれが有用だとは思わないので、特異なハッシュの配列に物を保存しませんでした。

あなたのシナリオは通常のものではありません。これをある程度一般化しようとしましたが、このコードの特異性を克服することはできませんでした。

  • まず第一に、同じ ID を持つすべてのものを (例外を除いて) マージされたエンティティに折りたたむように見えるため、エンティティの定義をプルする構造をたどる必要があります。レベルをツリー形式にしたいので、レベルを追跡します。

  • 次に、可能な限りエンティティをマージして、ID テーブルを組み立てます。ある場所では空の配列として、別の場所ではレベルとして 995 が定義されていることに注意してください。あなたの出力を踏まえて、空のリストをハッシュで上書きしたいと思いました。

  • その後、各レベルで正規エンティティを識別子に割り当てるために、ルートを結果構造に移動し、それを降順で移動する必要があります。

私が言ったように、それはそれほど定期的なものではありません。もちろん、まだペアにすぎないハッシュのリストが必要な場合は、それはあなたに残されている演習です。

use strict;
use warnings;

# subroutine to identify all elements
sub descend_identify {
    my ( $level, $hash_ref ) = @_;
    # return an expanding list that gets populated as we desecend 
    return map {
        my $item = $hash_ref->{$_};
        $_ => ( $level, $item )
            , ( ref( $item ) eq 'HASH' ? descend_identify( $level + 1, $item ) 
              :                          ()
              )
           ;
    } keys %$hash_ref
    ;
}

# subroutine to refit all nested elements
sub descend_restore { 
    my ( $hash, $ident_hash ) = @_;

    my @keys        = keys %$hash;
    @$hash{ @keys } = @$ident_hash{ @keys };
    foreach my $h ( grep { ref() eq 'HASH' } values %$hash ) {
        descend_restore( $h, $ident_hash );
    }
    return;
}

# merge hashes, descending down the hash structures.
sub merge_hashes {
    my ( $dest_hash, $src_hash ) = @_;
    foreach my $key ( keys %$src_hash ) {
        if ( exists $dest_hash->{$key} ) {
            my $ref = $dest_hash->{$key};
            my $typ = ref( $ref );
            if ( $typ eq 'HASH' ) {
                merge_hashes( $ref, $src_hash->{$key} );
            }
            else { 
                push @$ref, $src_hash->{$key};
            }
        }
        else {
            $dest_hash->{$key} = $src_hash->{$key};
        }
    }
    return;
}

my ( %levels, %ident_map, %result );

#descend through every level of hash in the list
# @hash_list is assumed to be whatever you Dumper-ed.
my @pairs = map { descend_identify( 0, $_ ); } @hash_list;

while ( @pairs ) {
    my ( $key, $level, $ref ) = splice( @pairs, 0, 3 );
    $levels{$key} |= $level;

    # if we already have an identity for this key, merge the two
    if ( exists $ident_map{$key} ) {
        my $oref = $ident_map{$key};
        my $otyp = ref( $oref );
        if ( $otyp ne ref( $ref )) {
            # empty arrays can be overwritten by hashrefs -- per 995
            if ( $otyp eq 'ARRAY' && @$oref == 0 && ref( $ref ) eq 'HASH' ) {
                $ident_map{$key} = $ref;
            }
            else { 
                die "Uncertain merge for '$key'!";
            }
        }
        elsif ( $otyp eq 'HASH' ) {
            merge_hashes( $oref, $ref );
        }
        else {
            @$oref = sort { $a <=> $b || $a cmp $b } keys %{{ @$ref, @$oref }};
        }
    }
    else {
        $ident_map{$key} = $ref;
    }
}

# Copy only the keys that do not appear at higher levels to the 
# result hash
if ( my @keys = grep { !$levels{$_} } keys %ident_map ) { 
    @result{ @keys } = @ident_map{ @keys } if @keys;

}
# then step through the hash to make sure that the entries at
# all levels are equal to the identity
descend_restore( \%result, \%ident_map );
于 2010-05-04T20:32:42.833 に答える
2

CPANを使用してください！Hash::Merge を試す

# OO interface.  
my $merge = Hash::Merge->new( 'LEFT_PRECEDENT' );
my %c = %{ $merge->merge( \%a, \%b ) };

詳細については、CPAN を参照してください。CPAN は、必要なすべてのことを行い、完全にカスタマイズ可能です。

于 2010-05-04T19:56:33.123 に答える
1

この再帰的なソリューションを試してみてください:

#   XXX: doesn't handle circular problems...
sub deepmerge {
    my (@structs) = @_;
    my $new;

    # filter out non-existant structs
    @structs = grep {defined($_)} @structs;

    my $ref = ref($structs[0]);
    if (not all(map {ref($_) eq $ref} @structs)) { 
        warn("deepmerge: all structs are not $ref\n");
    } 

    my @tomerge = grep {ref($_) eq $ref} @structs;
    return qr/$tomerge[0]/ if scalar(@tomerge) == 1 and $ref eq 'Regexp';
    return $tomerge[0] if scalar(@tomerge) == 1;

    if ($ref eq '') { 
        $new = pop(@tomerge); # prefer farthest right
    } 
    elsif ($ref eq 'Regexp') { 
        $new = qr/$tomerge[$#tomerge]/;
    } 
    elsif ($ref eq 'ARRAY') { 
        $new = [];
        for my $i (0 .. max(map {scalar(@$_) - 1} @tomerge)) { 
            $new->[$i] = deepmerge(map {$_->[$i]} @tomerge);
        }
    } 
    elsif ($ref eq 'HASH') { 
        $new = {};
        for my $key (uniq(map {keys %$_} @tomerge)) { 
            $new->{$key} = deepmerge(map {$_->{$key}} @tomerge);
        }
    }
    else {
        # ignore all other structures...
        $new = '';
    }

    return $new;
}

希望する結果を得るために、心ゆくまで変更してください。

さらに調査したところ、上記のアルゴリズムとは異なる方法でそれらをマージしていることに気付きました。たぶん、これを例として使用してください。私はこれを行います：

deepmerge({k => 'v'}, {k2 => 'v2'});
# returns {k => 'v', k2 => 'v2'}

配列についても同様です。

于 2010-05-04T18:30:55.747 に答える
0

上記のデータがファイル dump.txt にあると仮定すると、それを 1 つずつ評価できます。

以下の更新されたコード

use strict;
use File::Slurp;
my $final_data = {}; 
my @data = map {eval $_} (read_file("dump.txt") =~ /\$VAR1 = ([^;]+);/gs);
foreach my $element (@data) {
    my $key = (keys %$element)[0]; 
    $final_data->{$key} ||= []; 
    push @{$final_data->{$key}}, $element->{$key}
}; 
use Data::Dumper; 
print Data::Dumper->Dump([$final_data]);

完全にディープ マージしたい場合は、最後に $final_data をこの (テストされていません!!!) ディープ マージに渡すことができます。

# Merge an array of hashes as follows:
# IN:  [ { 1 => 11 }, { 1 => 12 },{ 2 => 22 } ]
# OUT: { 1 => [ 11, 12 ], 2 => [ 22 ] }
# This is recursive - if array [11,12] was an array of hashrefs, we merge those too
sub merge_hashes {
    my $hashes = @_[0];
    return $hashes unless ref $hashes eq ref []; # Hat tip to brian d foy
    return $hashes unless grep { ref @_ eq ref {} } @$hashes; # Only merge array of hashes
    my $final_hashref = {};
    foreach my $element (@$hashes) {
        foreach my $key (keys %$element) {
            $final_hashref->{$key} ||= [];
            push @{ $final_hashref->{$key} }, $element->{$key};
        }
    }
    foreach my $key (keys %$final_hashref) {
        $final_hashref->{$key} = merge_hashes($final_hashref->{$key});
    }
    return $final_hashref;
}
于 2010-05-04T18:05:43.637 に答える
0

回答したい他の人の利益のために、読みにくいため、必要な出力をインデントしました。私はまだ答えを考えています。

$VAR1 = { '999:' => [
                      { '992' => [ '905' ] },
                      { '993' => [
                                   { '909' => [] },
                                   { '904' => [] },
                                   { '902' => [] }
                                 ]
                      },
                      { '994' => [
                                   { '910' => [] },
                                   { '985' => [] },
                                   { '983' => [] }
                                 ]
                      },
                      { '995' => [
                                   { '101' => [] },
                                   { '102' => [] },
                                   { '103' => [] },
                                   { '104' => [] },
                                   { '105' => [] },
                                   { '106' => [] },
                                   { '107' => [] }
                                 ]
                      },
                      { '996' => [] },
                      { '997' => [ '986', '987', '990', '984', '989', '988' ] },
                      { '998' => [ '908', '906', '0', '998', '907' ] },
                      { '991' => [ '913', '920', '918', '998', '916', '919', '917', '915', '912', '914' ] }
                    ]
        };

ただし、これらすべての単一エントリハッシュのポイントがわかりません。次のほうがよいのではないでしょうか?

$VAR1 = { '999:' => {
                      '992' => [ '905' ],
                      '993' => {
                                 '909' => [],
                                 '904' => [],
                                 '902' => []
                               },
                      '994' => {
                                 '910' => [],
                                 '985' => [],
                                 '983' => []
                               },
                      '995' => {
                                 '101' => [],
                                 '102' => [],
                                 '103' => [],
                                 '104' => [],
                                 '105' => [],
                                 '106' => [],
                                 '107' => []
                               },
                      '996' => [],
                      '997' => [ '986', '987', '990', '984', '989', '988' ],
                      '998' => [ '908', '906', '0', '998', '907' ],
                      '991' => [ '913', '920', '918', '998', '916', '919', '917', '915', '912', '914' ]
                    }
        };
于 2010-05-04T17:36:24.313 に答える
0

おお。みんな（特にAxeman）本当にありがとう！コードや説明が不足していて申し訳ありません。私はツリーを生成しようとしていて、Hash::Merge を試しましたが、空の 995 を空でない 995 に置き換えるという造語の 995 問題を一生解決できませんでした。 ; Axeman のソリューションは美しく機能し、ヘルプ/コラボレーションに本当に感謝しています! (他のものも試してみましたが、Hash::Merge と同じことをしたか、実際にいくつかのブランチを削除しました)。

入力の背景: 一連のハッシュがあり、それぞれにキー (すべて同じレベル) があり、そのうちの 2 つは a) 別の親の親、b) それ自体 (残りは子) を定義していたので、ツリーの場合、iハッシュが完璧であると判断し、一連の新しいハッシュ {a}->{b}->[c] を考え出して、ここにいます...

もう一度、みんなとAxemanに感謝します！

于 2010-05-05T13:57:09.193 に答える
0

使用pushと自動活性化。

通常の前付から始めます。

#! /usr/bin/perl

use warnings;
use strict;

ファイルハンドルからサンプル入力を読み取り、DATAダンプしたものと同様のデータ構造を作成します。

my @hashes;
while (<DATA>) {
  my $VAR1;
  $VAR1 = eval $_;
  die $@ if $@;
  push @hashes => $VAR1;
}

入力には 2 つのケースがあります。

  1. 同じ「キー パス」を持ついとことマージされるデータを含む配列への参照。
  2. それ以外の場合は、ある深さでケース 1 の配列への参照を含むハッシュへの参照であるため、最も外側の層を取り除き、掘り続けます。

の使用に注意してください$_[0]。Perl サブルーチンのセマンティクスは、値がコピーではなくエイリアスであるような@_ものです。mergeこれにより、マージされたコンテンツを保持するための多数のスキャフォールディングを最初に作成することなく、直接呼び出すことができます。代わりに値をコピーすると、コードが壊れます。

sub merge {
  my $data = shift;

  if (ref($data) eq "ARRAY") {
    push @{ $_[0] } => @$data;
  }
  else {
    foreach my $k (%$data) {
      merge($data->{$k} => $_[0]{$k});
    }
  }
}

ここで@hashes、それらのコンテンツを歩いて段階的に にマージします%merged。

my %merged;    
foreach my $h (@hashes) {
  foreach my $k (keys %$h) {
    merge $h->{$k} => $merged{$k};
  }
}

値が到着した順序がわからないため、最後のクリーンアップ パスを実行して配列を並べ替えます。

sub sort_arrays {
  my($root) = @_;
  if (ref($root) eq "ARRAY") {
    @$root = sort { $a <=> $b } @$root;
  }
  else {
    sort_arrays($root->{$_}) for keys %$root;
  }
}

sort_arrays \%merged;

Data::Dumper モジュールは素早いデバッグに最適です!

use Data::Dumper;
$Data::Dumper::Indent = 1;
print Dumper \%merged;

質問からの入力のコピーを特別なDATAファイルハンドルに配置します。

__DATA__
$VAR1 = { '999' => { '998' => [ '908', '906', '0', '998', '907' ] } };
$VAR1 = { '999' => { '991' => [ '913', '920', '918', '998', '916', '919', '917', '915', '912', '914' ] } };
$VAR1 = { '999' => { '996' => [] } };
$VAR1 = { '999' => { '995' => [] } };
$VAR1 = { '999' => { '994' => [] } };
$VAR1 = { '999' => { '993' => [] } };
$VAR1 = { '999' => { '997' => [ '986', '987', '990', '984', '989', '988' ] } };
$VAR1 = { '995' => { '101' => [] } };
$VAR1 = { '995' => { '102' => [] } };
$VAR1 = { '995' => { '103' => [] } };
$VAR1 = { '995' => { '104' => [] } };
$VAR1 = { '995' => { '105' => [] } };
$VAR1 = { '995' => { '106' => [] } };
$VAR1 = { '995' => { '107' => [] } };
$VAR1 = { '994' => { '910' => [] } };
$VAR1 = { '993' => { '909' => [] } };
$VAR1 = { '993' => { '904' => [] } };
$VAR1 = { '994' => { '985' => [] } };
$VAR1 = { '994' => { '983' => [] } };
$VAR1 = { '993' => { '902' => [] } };
$VAR1 = { '999' => { '992' => [ '905' ] } };

出力のサンプルを以下に示します。

  '994' => {
    '910' => [],
    '985' => [],
    '983' => []
  }、
  '999' => {
    '993' => [],
    '992' => [
      '905'
    ]、
    '997' => [
      '984',
      '986',
      '987',
      '988',
      '989',
      「990」
    ]、
于 2010-05-04T18:43:59.467 に答える