從哈希列表中創建一個多級別哈希

Question

我想寫一個可以接受哈希列表並創建一個基於任意數量的字段內容的嵌套列表的子。我無法正確地獲得遞歸設置。我從數據庫中獲取了一堆缺陷數據，並希望將數據分組到任意字段列表（團隊，優先級等）。我真的沒有任何的示例代碼，我認爲即使是足夠接近

實例下

我有以下DS：

$ds = 
[ 
    { 
    foo => 'A', 
    bar => 'B', 
    baz => 'C', 
    }, 
    { 
    foo => 'A', 
    bar => 'B', 
    baz => 'F', 
    }, 
    { 
    foo => 'A', 
    bar => 'D', 
    baz => 'G', 
    }, 
    { 
    foo => 'R', 
    bar => 'J', 
    baz => 'G', 
    } 
] 

考慮下面的函數調用

# prototype groupBy(data, field-1,field-2,field-n) 
groupBy($ds,'foo','bar'); 

我想要以下輸出

$res = { 
     A => { 
       B => [ 
         { 
         foo => 'A', 
         bar => 'B', 
         baz => 'C', 
         }, 
         { 
         foo => 'A', 
         bar => 'B', 
         baz => 'F', 
         } 
        ], 
       D => [ 
         { 
         foo => 'A', 
         bar => 'D', 
         baz => 'G', 
         } 
        ], 
       }, 
     R => { 
       J => [ 
         { 
          foo => 'R', 
          bar => 'J', 
          baz => 'G', 
         } 
       } 

     }; 

Answer 1

這是使用遞歸方法非常簡單

下面的代碼說明

和

use strict; 
use warnings; 

my $ds = [ 
    { bar => "B", baz => "C", foo => "A" }, 
    { bar => "B", baz => "F", foo => "A" }, 
    { bar => "D", baz => "G", foo => "A" }, 
    { bar => "J", baz => "G", foo => "R" }, 
]; 

my $grouped = groupBy($ds, qw/ foo bar /); 

use Data::Dump; 
dd $grouped; 

sub groupBy { 

    my ($ds, $key, @rest) = @_; 
    return $ds unless $key; 

    my %groups; 
    push @{ $groups{$_->{$key}} }, $_ for @$ds; 
    $groups{$_} = groupBy($groups{$_}, @rest) for keys %groups; 

    return \%groups; 
} 

輸出

{ 
    A => { 
     B => [ 
       { bar => "B", baz => "C", foo => "A" }, 
       { bar => "B", baz => "F", foo => "A" }, 
       ], 
     D => [{ bar => "D", baz => "G", foo => "A" }], 
     }, 
    R => { J => [{ bar => "J", baz => "G", foo => "R" }] }, 
} 

Answer 2

硬編碼的解決方案：

my $res; 
for (@$ds) { 
    push @{ $res->{ $_->{foo} }{ $_->{bar} } }, $_; 
} 

但要支持密鑰的長度可變的列表。只需添加一些循環。

sub groupBy { 
    my ($ds, @keys) = @_; 
    my $res; 
    for (@$ds) { 
     my $p = dive($res, @$_{ @keys }); 
     push @$$p, $_; 
    } 
    return $res; 
} 

其中dive要麼是

sub dive { 
    my $p = \shift; 
    $p = \($$p->{$_}) for @_; 
    return $p; 
} 

或

use Data::Diver qw(DiveRef); 
sub dive { 
    $_[0] //= {}; 
    return DiveRef(shift, map \$_, @_); 
}