Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

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

by LanX (Saint)
on Feb 03, 2020 at 01:21 UTC ( [id://11112298]=note: print w/replies, xml ) Need Help??


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

For the record: your output is significantly different from others, because you allow single elements to appear multiple times, like in "aaa".

The OP said "repetitions allowed", but I read this as the numbers don't need to be pairwise different.

To increase the confusion does his demo not show any repetitions.

>

... all possible 3 elements ; a+b+c a+b+d a+b+e ...

slightly annoying.

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

Replies are listed 'Best First'.
Re^3: Sum of N elements in an M element array
by Marshall (Canon) on Feb 13, 2020 at 07:36 UTC
    Ok, I wanted to show the glob combination gizmo and the spec wasn't perfect.
    For permutations 3 of a set of 5, consider the following.
    No element is repeated, meaning no element of the input array appears more than once per "sum"
    I just sorted the output in my program editor rather than adding that feature to the Perl code.
    #!/usr/bin/perl use strict; use warnings; use Algorithm::Permute; my $p = Algorithm::Permute->new(['a','b','c','d','e'], 3); while (my @res = $p->next) { print join("+", @res), "\n"; } __END__ # I just used my editor to sort the output # adapt the above code as you wish a+b+c a+b+d a+b+e a+c+b a+c+d a+c+e a+d+b a+d+c a+d+e a+e+b a+e+c a+e+d b+a+c b+a+d b+a+e b+c+a b+c+d b+c+e b+d+a b+d+c b+d+e b+e+a b+e+c b+e+d c+a+b c+a+d c+a+e c+b+a c+b+d c+b+e c+d+a c+d+b c+d+e c+e+a c+e+b c+e+d d+a+b d+a+c d+a+e d+b+a d+b+c d+b+e d+c+a d+c+b d+c+e d+e+a d+e+b d+e+c e+a+b e+a+c e+a+d e+b+a e+b+c e+b+d e+c+a e+c+b e+c+d e+d+a e+d+b e+d+c

      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

        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;

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others about the Monastery: (None)
    As of 2024-04-25 00:51 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      No recent polls found