use 5.026;
use warnings;

use Benchmark  qw{ cmpthese };
use Test::More qw{ no_plan };

use List::Util qw{ sum };
use Algorithm::Permute;
use Algorithm::Combinatorics qw{ combinations };

my %methods  = (
   johngg => sub {
       my $raValues = shift;
       allSums( $raValues );
       },
   permutations => sub {
       my $raValues = shift;
       permuteSums( $raValues );
       },
   combinations => sub {
       my $raValues = shift;
       combineSums( $raValues );
       },
   );

my $raTest     = [ 1, 2, 3, 4, 5 ];
my $raExpected = [
  [],
  [],
  [
    {
      '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
    }
  ]
];

foreach my $method ( sort keys %methods )
{
    is_deeply(
       $methods{ $method }->( $raTest ),
       $raExpected,
       $method
    );
}

$raTest = [ map { int rand 500 } 1 .. 10 ];
cmpthese(
   -30,
   {
       map
       {
           my $codeStr
          = q|sub { my $raAllSums = $methods{ |
          . $_
          . q| }->( $raTest ); }|;
       $_ => eval $codeStr;
       }
       keys %methods
   }
   );

sub combineSums
{
    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 $raIdx = [ 0 .. $nElems - 1 ];
        my $comb  = combinations( $raIdx, $sumsOf );

        while ( my $raComb = $comb->next() )
        {
            push @{ $raSums->[ $sumsOf ] },
               {
                   join( q{+}, $raNumbers->@[ @{ $raComb } ] ),
                   sum $raNumbers->@[ @{ $raComb } ]
               };
        }
    }

    return $raSums;
}

sub permuteSums
{
    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 $raIdx = [ 0 .. $nElems - 1 ];
        my $perm  = Algorithm::Permute->new(
           $raIdx, $sumsOf );
        my @allPerms;
        while ( my @res = $perm->next() )
        {
            push @allPerms, [ sort { $a <=> $b } @res ];
        }

        my @uniqPerms = do {
           my %seen;
           map  { [ unpack q{N*}, $_ ] }
           sort
           grep { ! $seen{ $_ } ++ }
           map  { pack q{N*}, @{ $_ } }
           @allPerms
           };
        foreach my $raPerm ( @uniqPerms )
        {
            push @{ $raSums->[ $sumsOf ] },
               {
                   join( q{+}, $raNumbers->@[ @{ $raPerm } ] ),
                   sum $raNumbers->@[ @{ $raPerm } ]
               };
        }
    }

    return $raSums;
}

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;
       };
}
[download]