 Just another Perl shrine PerlMonks

### Re: Sum of N elements in an M element array

by johngg (Canon)
 on Feb 03, 2020 at 22:59 UTC Need Help??

in reply to Sum of N elements in an M element array

It's probably a bit late to post this but since the code is now written I might as well. Corion's mention of a binary counter made me think of this thread in which I ventured this solution. I can use this to generate all strings of, say, three ones and two zeros and then use a regex and pos to generate an array of elements to sum. Because the iterator returns strings in this order for the above example

```00111
01011
01101
01110
10011
10101
10110
11001
11010
11100

I use unshift rather than push to build the array of sums so that they are in the same order as in the OP. The routine returns a ref. to an AoAoH where elements 0 and 1 are empty, element 2 contains an array of hashes of all possible 2-element sums where the key is the string representing the sum and the value is the result, element 3 an array of hashes of 3-element sums etc. The code:-

```use 5.026;
use warnings;

use List::Util qw{ sum };
use Data::Dumper;

my @tests = (
5,
[ 1 ],
[ 1, 2 ],
[ 1, 2, 3 ],
[ 1, 2, 3, 4 ],
[ 1, 2, 3, 4, 5 ],
[ 4, 17, 9, 23, 1, 14 ],
);

foreach my \$test ( @tests )
{
my \$raRes = allSums( \$test ) or do {
warn qq{\$test: Not an array ref.\n};
say q{-} x 25;
next;
};
print Data::Dumper
->new( [ \$test, \$raRes ], [ qw{ test raRes }] )
->Indent( 1 )
->Dumpxs();
say q{-} x 25;
}

sub allSums
{
my \$raNumbers = shift;
return 0 unless ref( \$raNumbers ) eq q{ARRAY};

my \$raSums = [ [], [], ];
my \$nElems = scalar @{ \$raNumbers };

if ( \$nElems < 3 )
{
return \$raSums;
}

foreach my \$sumsOf ( 2 .. \$nElems - 1 )
{
my \$nZeros = \$nElems - \$sumsOf;
my \$rcNext = permutary( \$nZeros, \$sumsOf );

while ( my \$str = \$rcNext->() )
{
my @posns;
push @posns, pos \$str while \$str =~ m{(?=1)}g;
unshift @{ \$raSums->[ \$sumsOf ] },
{
join( q{+}, @{ \$raNumbers }[ @posns ] ),
sum @{ \$raNumbers }[ @posns ]
};
}

}
return \$raSums;
}

sub permutary
{
no warnings qw{ portable };

my ( \$numZeros, \$numOnes ) = @_;

my \$format = q{%0} . ( \$numZeros + \$numOnes ) . q{b};
my \$start  = oct( q{0b} . q{1} x \$numOnes );
my \$limit  = oct( q{0b} . q{1} x \$numOnes . q{0} x \$numZeros );

return sub
{
return undef if \$start > \$limit;

my \$binStr = sprintf \$format, \$start;
die qq{Error: \$binStr not \$numOnes ones\n}
unless \$numOnes == \$binStr =~ tr{1}{};

my \$jump = 0;
if ( \$binStr =~ m{(1+)\$} )
{
\$jump = 2 ** ( length(\$1) - 1 );
}
elsif ( \$binStr =~ m{(1+)(0+)\$} )
{
\$jump  = 2 ** ( length(\$1) - 1 ) + 1;
\$jump += 2 ** \$_ for 1 .. length( \$2 ) - 1;
}
else
{
die qq{Error: \$binStr seems malformed\n};
}
\$start += \$jump;
return \$binStr;
};
}

The results:-

```5: Not an array ref.
-------------------------
\$test = [
1
];
\$raRes = [
[],
[]
];
-------------------------
\$test = [
1,
2
];
\$raRes = [
[],
[]
];
-------------------------
\$test = [
1,
2,
3
];
\$raRes = [
[],
[],
[
{
'1+2' => 3
},
{
'1+3' => 4
},
{
'2+3' => 5
}
]
];
-------------------------
\$test = [
1,
2,
3,
4
];
\$raRes = [
[],
[],
[
{
'1+2' => 3
},
{
'1+3' => 4
},
{
'1+4' => 5
},
{
'2+3' => 5
},
{
'2+4' => 6
},
{
'3+4' => 7
}
],
[
{
'1+2+3' => 6
},
{
'1+2+4' => 7
},
{
'1+3+4' => 8
},
{
'2+3+4' => 9
}
]
];
-------------------------
\$test = [
1,
2,
3,
4,
5
];
\$raRes = [
[],
[],
[
{
'1+2' => 3
},
{
'1+3' => 4
},
{
'1+4' => 5
},
{
'1+5' => 6
},
{
'2+3' => 5
},
{
'2+4' => 6
},
{
'2+5' => 7
},
{
'3+4' => 7
},
{
'3+5' => 8
},
{
'4+5' => 9
}
],
[
{
'1+2+3' => 6
},
{
'1+2+4' => 7
},
{
'1+2+5' => 8
},
{
'1+3+4' => 8
},
{
'1+3+5' => 9
},
{
'1+4+5' => 10
},
{
'2+3+4' => 9
},
{
'2+3+5' => 10
},
{
'2+4+5' => 11
},
{
'3+4+5' => 12
}
],
[
{
'1+2+3+4' => 10
},
{
'1+2+3+5' => 11
},
{
'1+2+4+5' => 12
},
{
'1+3+4+5' => 13
},
{
'2+3+4+5' => 14
}
]
];
-------------------------
\$test = [
4,
17,
9,
23,
1,
14
];
\$raRes = [
[],
[],
[
{
'4+17' => 21
},
{
'4+9' => 13
},
{
'4+23' => 27
},
{
'4+1' => 5
},
{
'4+14' => 18
},
{
'17+9' => 26
},
{
'17+23' => 40
},
{
'17+1' => 18
},
{
'17+14' => 31
},
{
'9+23' => 32
},
{
'9+1' => 10
},
{
'9+14' => 23
},
{
'23+1' => 24
},
{
'23+14' => 37
},
{
'1+14' => 15
}
],
[
{
'4+17+9' => 30
},
{
'4+17+23' => 44
},
{
'4+17+1' => 22
},
{
'4+17+14' => 35
},
{
'4+9+23' => 36
},
{
'4+9+1' => 14
},
{
'4+9+14' => 27
},
{
'4+23+1' => 28
},
{
'4+23+14' => 41
},
{
'4+1+14' => 19
},
{
'17+9+23' => 49
},
{
'17+9+1' => 27
},
{
'17+9+14' => 40
},
{
'17+23+1' => 41
},
{
'17+23+14' => 54
},
{
'17+1+14' => 32
},
{
'9+23+1' => 33
},
{
'9+23+14' => 46
},
{
'9+1+14' => 24
},
{
'23+1+14' => 38
}
],
[
{
'4+17+9+23' => 53
},
{
'4+17+9+1' => 31
},
{
'4+17+9+14' => 44
},
{
'4+17+23+1' => 45
},
{
'4+17+23+14' => 58
},
{
'4+17+1+14' => 36
},
{
'4+9+23+1' => 37
},
{
'4+9+23+14' => 50
},
{
'4+9+1+14' => 28
},
{
'4+23+1+14' => 42
},
{
'17+9+23+1' => 50
},
{
'17+9+23+14' => 63
},
{
'17+9+1+14' => 41
},
{
'17+23+1+14' => 55
},
{
'9+23+1+14' => 47
}
],
[
{
'4+17+9+23+1' => 54
},
{
'4+17+9+23+14' => 67
},
{
'4+17+9+1+14' => 45
},
{
'4+17+23+1+14' => 59
},
{
'4+9+23+1+14' => 51
},
{
'17+9+23+1+14' => 64
}
]
];
-------------------------

I hope this is of interest.

Cheers,

JohnGG

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

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (7)
As of 2020-08-12 16:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Which rocket would you take to Mars?

Results (66 votes). Check out past polls.

Notices?