Perl-Sensitive Sunglasses PerlMonks

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

by johngg (Canon)
 on Feb 13, 2020 at 10:38 UTC Need Help??

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 (Abbot) 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.
This stuff about pack and unpack N can be a bit tricky.

Create A New User
Node Status?
node history
Node Type: note [id://11112917]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (3)
As of 2020-06-07 04:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Do you really want to know if there is extraterrestrial life?

Results (42 votes). Check out past polls.

Notices?