3
\$\begingroup\$

The following is a solution to the knapsack problem and supposed to be my entry to this weeks perl challenge. I wonder if this is a good use of dynamic variables or is it too confusing?

I use them so I don't have to put the variables $n, @things and @result in all the signatures of the multi-subs and carry them through the recursion.

sub MAIN()
{
    my @data =
        { thing => 'R', weight =>  1, amount =>  1 },
        { thing => 'B', weight =>  1, amount =>  2 },
        { thing => 'G', weight =>  2, amount =>  2 },
        { thing => 'Y', weight => 12, amount =>  4 },
        { thing => 'P', weight =>  4, amount => 10 }
    ;

    my ( $v, $w, @t ) = knapsack( 15, 5, @data );

    say "Value: $v, Weight: $w";
    say "Taken: ", join ",", @t.map: *<thing>;
}

multi sub knapsack( Int $total-weight, Int $*n, @*things )
{
    my @*results;
    my Int $optimal-value  = my Int $current-value  = knapsack( $total-weight, 0 );
    my Int $optimal-weight = my Int $current-weight = @*results[0].pairs.first({ .value eqv $optimal-value }).key // -1;

    return $optimal-value, $optimal-weight, |gather
    {
        # walk the results and find the good ones
        for ^$*n -> $i
        {
            my %d           = @*things[ $i ];
            my $next-weight = $current-weight - %d<weight>;
            my $next-value  = @*results[ $i + 1; $next-weight ];

            with $next-value
            {
                if $next-weight >= 0 && $next-value == $current-value - %d<amount>
                {
                    take @*things[ $i ];
                    $current-value -= %d<amount>;
                    $current-weight -= %d<weight>;
                }
            }
        }

        take @*things[ $*n - 1 ]
                if $current-value > 0;
    };
}

multi sub knapsack( Int $weight, Int $i where @*results[ $i ; $weight ].defined ) { @*results[ $i ; $weight ] }
multi sub knapsack( Int $weight, Int $i where $i >= $*n ) { 0 }
multi sub knapsack( Int $weight, Int $i where $i < $*n )
{
    my $leftover-weight = $weight - @*things[ $i ]<weight>;
    my $current-value   = knapsack( $weight, $i + 1 );

    my $next-value = $leftover-weight >= 0
        ?? ( @*things[ $i ]<amount> + knapsack( $leftover-weight, $i + 1 ) )
        !! 0;

    @*results[ $i ; $weight ] = ( $current-value, $next-value ).max
}
\$\endgroup\$

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Browse other questions tagged or ask your own question.