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; }; }