Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Re^4: Sum of N elements in an M element array

by johngg (Canon)
on Feb 13, 2020 at 10:38 UTC ( [id://11112917]=note: print w/replies, xml ) Need Help??


in reply to Re^3: Sum of N elements in an M element array
in thread Sum of N elements in an M element array

Whilst it is true that no element is repeated, for the purposes of the OP, this solution will produce multiple results for the same three elements being summed in a different order. Some form of filtering, perhaps involving a numerical sort of element numbers, a pack to a string and a grep with a %seen hash, would be required to remove duplicates.

Update: Here's some code to show what I mean. All the faff with pack q{N*}, @{ $_ } is because we may be dealing with larger arrays where subscripts go into multiple digits. This code:-

use 5.026; use warnings; use Algorithm::Permute; my @arr = ( 1, 2, 3, 4, 5 ); my $perm = Algorithm::Permute->new( [ 0 .. $#arr ], 3 ); my @allPerms; while ( my @res = $perm->next() ) { push @allPerms, [ sort { $a <=> $b } @res ]; } my @uniqPerms = do { my %seen; map { [ unpack q{N*}, $_ ] } grep { ! $seen{ $_ } ++ } sort map { pack q{N*}, @{ $_ } } @allPerms }; say join q{+}, @{ $_ } for @uniqPerms;

Produces:-

0+1+2 0+1+3 0+1+4 0+2+3 0+2+4 0+3+4 1+2+3 1+2+4 1+3+4 2+3+4

Cheers,

JohnGG

Replies are listed 'Best First'.
Re^5: Sum of N elements in an M element array
by Marshall (Canon) on Feb 14, 2020 at 20:32 UTC
    Seems perhaps at bit overly complex to me. Here is modified version of my code:
    #!/usr/bin/perl use strict; use warnings; use Algorithm::Permute; my $p = Algorithm::Permute->new(['a','b','c','d','e'], 3); my @results; while (my @res = $p->next) { push @results, [@res = sort @res]; # use a different sort for numbe +rs } my %seen; @results = map {!$seen{"@$_"}++? $_:() }@results; # remove duplicates! print join ("+",@$_)."\n" for @results; __END__ Prints: Again I sorted results in program editor because actual program probably doesn't need that feature. a+b+c a+b+d a+b+e a+c+d a+c+e a+d+e b+c+d b+c+e b+d+e c+d+e The unsorted output for reference:: a+b+c b+c+d a+c+d a+b+d b+c+e a+c+e b+d+e c+d+e a+d+e a+b+e
    Now of course the code could be modified so that a duplicate is not inserted into the @results array to begin with. However, I would recommend this 2 step process because it is easier to debug.

    Update: Improved Code, re suggestions from AnomalousMonk.

    #!/usr/bin/perl use strict; use warnings; use Algorithm::Permute; my $p = Algorithm::Permute->new(['a','b','c','d','e'], 3); my @results; while (my @res = $p->next) { push @results, [sort @res]; # use a different sort for numbers } my %seen; @results = grep{!$seen{"@$_"}++ }@results; # remove duplicates! print join ("+",@$_)."\n" for @results;

      The code can be further (slightly) simplified:

      • [@res = sort @res] to  [ sort @res ]
      • map {!$seen{"@$_"}++? $_:() }@results to  grep { !$seen{"@$_"}++ } @results;

      Be that as it may, johngg's approach of permuting indices is IMHO better because it is more general: it can be applied to an array of any mix of any type of elements with no worries about sorting:

      c:\@Work\Perl\monks>perl use strict; use warnings; use Test::More 'no_plan'; use Test::NoWarnings; use Algorithm::Permute; use List::MoreUtils qw(uniq); use Data::Dump qw(dd); my $ar_expected = [ qw(0+1+2 0+1+3 0+1+4 0+2+3 0+2+4 0+3+4 1+2+3 1+2+4 1+3+4 2+3+4) ]; my @arr = (1, 'two', -33, [ qw(f o u r) ], { V => 5 }); my $perm = Algorithm::Permute->new([ 0 .. $#arr ], 3); my @allIndicePermsSorted; while (my @res = $perm->next()) { push @allIndicePermsSorted, [ sort { $a <=> $b } @res ]; } my @uniqIndicePermsSorted = map [ unpack 'N*', $_ ], uniq sort map pack('N*', @$_), @allIndicePermsSorted ; my $ar_got = [ map join('+', @$_), @uniqIndicePermsSorted ]; is_deeply $ar_got, $ar_expected, 'unique sorted indices'; done_testing; dd [ @arr[ @$_ ] ] for @uniqIndicePermsSorted; exit; __END__ ok 1 - unique sorted indices 1..1 [1, "two", -33] [1, "two", ["f", "o", "u", "r"]] [1, "two", { V => 5 }] [1, -33, ["f", "o", "u", "r"]] [1, -33, { V => 5 }] [1, ["f", "o", "u", "r"], { V => 5 }] ["two", -33, ["f", "o", "u", "r"]] ["two", -33, { V => 5 }] ["two", ["f", "o", "u", "r"], { V => 5 }] [-33, ["f", "o", "u", "r"], { V => 5 }] ok 2 - no warnings 1..2
      (Actually, I think there are permutation algorithms that give unique sets in their original order to begin with! (Update: See e.g. Algorithm::Combinatorics::combinations(); I'm sure there are others!))

      Update: It might be advantageous to get rid of duplicates before sorting: gives sort less to do. For that, the somewhat syntactically awkward

      my @uniqIndicePermsSorted = map [ unpack 'N*', $_ ], sort +( uniq map pack('N*', @$_), @allIndicePermsSorted ) ;


      Give a man a fish:  <%-{-{-{-<

        I like your suggestions and code from johngg.
        Your point about grep is right on!
        This stuff about pack and unpack N can be a bit tricky.

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others sharing their wisdom with the Monastery: (7)
As of 2024-03-28 21:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found