Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Re^3: Counting elements in array of cases (updated)

by LanX (Archbishop)
on Sep 28, 2019 at 13:23 UTC ( #11106817=note: print w/replies, xml ) Need Help??


in reply to Re^2: Counting elements in array of cases
in thread Counting elements in array of cases

my take on it...
#!/usr/bin/perl -w # AoH_map.pl --- Perlmonks: Counting elements in array of cases # Link: https://perlmonks.org/?node_id=11106779 # Author: <LanX> # Base: <tybalt89> https://perlmonks.org/?node_id=11106792 # Created: 28 Sep 2019 # Version: 0.03 use warnings; use strict; use Test::More; sub transform { my %prev; my %origin; return map { my $target = $_->{targetL}; my $origin = $_->{origin}; if ( my $prev = $prev{$target} ) { $prev->{count} += $_->{count}; $prev->{origin} .= " $origin" unless $origin{$target}{$origin}++; # + ++ FIXED () # skip duplicate } else { $origin{$target}{$origin} = 1; $prev{$target} = { %$_ }; # return first (clone) } } @_; } # ---------- tests is_deeply ( [ transform( {'targetL' => 'foisonnement', 'origin' => 'AMG', 'count' => '1 +'}, {'targetL' => 'foisonnement', 'origin' => 'IDBR', 'count' => ' +1'}, {'targetL' => 'gonfler', 'origin' => 'IWWF', 'count' => '1'}, {'targetL' => 'due', 'origin' => 'IWWF', 'count' => '1' }, {'targetL' => 'due', 'origin' => 'IWWF', 'count' => '1' }, ) ], [ {'targetL' => 'foisonnement','origin' => 'AMG IDBR','count'=>' +2'}, {'targetL' => 'gonfler','origin' => 'IWWF','count' => '1'}, {'targetL' => 'due','origin' => 'IWWF','count' => '2'}, ] ); is_deeply ( [ transform( {'targetL' => 'foisonnement', 'origin' => 'AMG', 'count' => '1 +'}, {'targetL' => 'foisonnement', 'origin' => 'IDBR', 'count' => ' +1'}, {'targetL' => 'foisonnement', 'origin' => 'AMG', 'count' => '1 +'}, {'targetL' => 'foisonnement', 'origin' => 'IDBR', 'count' => ' +1'}, ) ], [ {'targetL' => 'foisonnement','origin' => 'AMG IDBR','count'=>' +4'}, ] ); done_testing;

C:/Perl_524/bin\perl.exe d:/tmp/pm/AoH_map.pl ok 1 ok 2 1..2 Compilation finished at Sun Sep 29 00:44:35

Cheers Rolf
(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

update

added missing ++ and testcase, see reply from rsFalse for details.

Replies are listed 'Best First'.
Re^4: Counting elements in array of cases
by rsFalse (Hermit) on Sep 28, 2019 at 18:19 UTC
    This is similar approach to mine (Re^4: Counting elements in array of cases).

    But can you test it on:
    {'targetL' => 'foisonnement', 'origin' => 'AMG', 'count' => '1 +'}, {'targetL' => 'foisonnement', 'origin' => 'IDBR', 'count' => ' +1'}, {'targetL' => 'foisonnement', 'origin' => 'AMG', 'count' => '1 +'}, {'targetL' => 'foisonnement', 'origin' => 'IDBR', 'count' => ' +1'},
      Yeah thanks, I even see the bug without testing.

      Ironically I first wrote unless ... ++ instinctively and then decided it's redundant. :)

      Will fix the code as soon as I get back to my PC

      update

      Fixed! :)

      Cheers Rolf
      (addicted to the Perl Programming Language :)
      Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://11106817]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (2)
As of 2020-02-24 05:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    What numbers are you going to focus on primarily in 2020?










    Results (104 votes). Check out past polls.

    Notices?