use strict; use warnings; my %groupOfBact = ( group1 => { strain1 => 1, strain2 => 1, strain4 => 1, }, group2 => { strain3 => 1, strain4 => 1, strain5 => 1, }, group3 => { strain6 => 1, strain7 => 1, }, ); my %bact_by_strain; for my $bact ( sort keys %groupOfBact ) { for my $strain ( keys %{ $groupOfBact{$bact} } ) { push @{ $bact_by_strain{$strain} }, $bact; } } my %delete; for my $strain ( keys %bact_by_strain ) { my $bacts = $bact_by_strain{$strain}; next if @$bacts < 2; my $dst = $bacts->[0]; for my $src ( @{$bacts}[ 1..$#$bacts ] ) { my $src_bact = $groupOfBact{$src}; my $dst_bact = $groupOfBact{$dst}; next if $src_bact == $dst_bact; %$dst_bact = ( %$dst_bact, %$src_bact ); $groupOfBact{$src} = $groupOfBact{$dst}; $delete{$src} = 1; } } delete @groupOfBact{ keys %delete }; use Data::Dumper qw( Dumper ); print(Dumper(\%groupOfBact));
It still does some unnecessary merges, though. ( Actually no, I fixed that before posting )
Update: This is the approach moritz mentioned.
In reply to Re: Merging Complex Hashes
by ikegami
in thread Merging Complex Hashes
by jpearl
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |