Re^4: Counting elements in array of cases

Here, I tried to change tybalt89's code by including one more hash deeper instead of uniq:

#!/usr/bin/perl

# https://perlmonks.org/?node_id=11106779

use strict;
use warnings;
use Data::Dumper;

my @AoH = (
    { count => 1, origin => "AMG", targetL => "foisonnement" },
    { count => 1, origin => "IDBR", targetL => "foisonnement" },
    { count => 1, origin => "AMG", targetL => "foisonnement" },
    { count => 1, origin => "IWWF", targetL => "gonfler" },
    { count => 1, origin => "IWWF", targetL => "due" },
    { count => 1, origin => "IWWF", targetL => "due" },
);

my %seen;
my @AoHfinal = # map { delete $_->{origins}; $_ } 
    map
    {
    if( my $prev = $seen{$_->{targetL}} )
        {
        $prev->{count} += $_->{count};
        
        if( not exists $prev->{origins}{ $_->{origin} } ){
            $prev->{origin} .= ' ' . $_->{origin};
            $prev->{origins}{ $_->{origin} } ++;
            }
        () # skip duplicate
        }
    else
        {
        $_->{origins}{ $_->{origin} } ++;
        $seen{$_->{targetL}} = { %$_ };
        }
    } @AoH;

print Dumper( \@AoHfinal );
[download]

OUTPUT:

$VAR1 = [
          {
            'count' => 3,
            'origin' => 'AMG IDBR',
            'targetL' => 'foisonnement',
            'origins' => {
                           'IDBR' => 1,
                           'AMG' => 1
                         }
          },
          {
            'count' => 1,
            'targetL' => 'gonfler',
            'origin' => 'IWWF',
            'origins' => {
                           'IWWF' => 1
                         }
          },
          {
            'count' => 2,
            'origins' => {
                           'IWWF' => 1
                         },
            'origin' => 'IWWF',
            'targetL' => 'due'
          }
        ];
[download]

Comment on Re^4: Counting elements in array of cases Select or Download Code


laziness, impatience, and hubris
	PerlMonks