Re: Challenge: Number of unique ways to reach target sum

[tall_man]

Here is a very late, but very fast solution to your challenge. It can find the count in less than two seconds. The trick is to use a result from partition theory and compute the counts using a "Pascal's triangle"-like approach.

#!/usr/bin/perl
use strict;
use warnings;
use PDL;
use PDL::NiceSlice;

# Compute the partition function P(n,k) using the recurrence
# relation:  P(n,k) = P(n-1,k-1) + P(n-k,k)
# Use this to solve the challenge Q(667,10).
# Q(667,10) = P(667 - 45, 10)
# Note: The 45 comes from (k)(k-1)/2, the sum of (0..k-1).

my $kmax = 10;
my $nmax = 667 - 45;

# Final results for unique partitions would be created by
# adding (0..9) to the plain partition results, so restrict
# my maximum extry to 91.
my $entrymax = 100 - 9;

my ($n, $k, %triangle);

sub shiftpdl {
    my ($pdl_a) = @_;
    my $pdl_b = rotate($pdl_a,1)->copy;
    $pdl_b(0) .= 0;
    return $pdl_b;
}

# Initialize corner of the triangle.
my $p1 = zeroes $entrymax;
$p1(0) .= 1;   # Single item with a max entry of one.
$triangle{1,1} = $p1;

# Use the recurrence relation to populate the triangle,
# but accumulate for each maximum number separately so
# we can shift off and eliminate cases that would take
# our maximum entry over 100.
for $n (2..$nmax) {
    for $k (1..$kmax) {
        my $psum = zeroes $entrymax;
        if (exists $triangle{$n-1,$k-1}) {
            # New entries for this case are created by tacking
            # on a one to each result, so the maximum is unchanged.
            $psum += $triangle{$n-1,$k-1};
        }
        if (exists $triangle{$n-$k, $k}) {
            # New entries for this case are created by adding
            # a one to each entry, so shift all counts up one place.
            $psum += shiftpdl($triangle{$n-$k, $k});
        }
        $triangle{$n,$k} = $psum;
    }
}

my $sum = sumover $triangle{$nmax,$kmax};
print "Total unique partitions C(677,10) on {1..100} is ",$sum,"\n";

The second issue is the ability to generate the sequence of partitions. The data structure in the code above supports this, too. In fact, it can do better. It can generate any partition by its sequence number, at any position.

#!/usr/bin/perl
use strict;
use warnings;
use PDL;
use PDL::NiceSlice;
use Carp::Assert;

# Compute the partition function P(n,k) using the recurrence
# relation:  P(n,k) = P(n-1,k-1) + P(n-k,k)
# Use this to solve the challenge Q(667,10).
# Q(667,10) = P(667 - 45, 10)

my $kmax = 10;
my $nmax = 667 - 45;

# Final results for unique partitions will be created by
# adding (0..9) to the plain partition results, so restrict
# my maximum extry to 91.
my $entrymax = 100 - 9;

# Space allocation for interspersed search.
my $entrymax2 = $entrymax * 2;

my ($n, $k, %triangle, %p);

sub shiftpdl {
    my ($pdl_a) = @_;
    my $pdl_b = rotate($pdl_a,1)->copy;
    $pdl_b(0) .= 0;
    return $pdl_b;
}

# Generate the partition at the given position number from
# zero to the maximum -1.
sub generate {
    my ($n, $k, $psn) = @_;

    # Stack of "commands" to generate the partition.
    my @commands;
    # Adjustment vector to go from plain partition to distinct values.
    my @adjust = reverse (0..$k-1);
    my $position = pdl($psn+1);  # Add one for vsearch

  GETPATH:
    while (1) {
        # Done when we reach the root.
        last GETPATH if ($n == 1 && $k == 1);

        assert(exists $p{$n, $k}, "p(n,k) must exist");
        my $pos_in_both = vsearch($position, $p{$n, $k})->sclr;

        if ($pos_in_both % 2 == 0) {
            # Even position means going up, to p(n-k,k)
            unshift @commands,0;
            assert($n-$k > 0,"n: $n - $k greater than zero on up move"
+);
            assert(exists $triangle{$n-$k,$k}, "triangle(n-k,k) must e
+xist");

            # Convert position number relative to new location.
            if ($pos_in_both > 0) {
                my $old_offset = $p{$n, $k}->at($pos_in_both-1);
                $position -= $old_offset;
            }
            my $pos = $pos_in_both/2;
            if ($pos > 1) {
                my $accum = cumusumover $triangle{$n-$k,$k};
                my $new_offset = $accum->at($pos-2);  # account for sh
+ift
                $position += $new_offset;
            }

            # Prepare for next iteration.
            $n -= $k;
        } else {
            # Odd means going diagonally, to p{$n-1, $k-1}
            unshift @commands,1;
            assert($n > 1 && $k > 1, "n: $n and k: $k both greater tha
+n one");
            assert(exists $triangle{$n-1,$k-1}, "triangle(n-1,k-1) mus
+t exist");

            # Convert position number relative to new location.
            if ($pos_in_both > 0) {
                my $old_offset = $p{$n, $k}->at($pos_in_both-1);
                $position -= $old_offset;
            }

            my $pos = ($pos_in_both - 1)/2;
            if ($pos > 0) {
                my $accum = cumusumover $triangle{$n-1,$k-1};
                my $new_offset = $accum->at($pos-1);  # account for sh
+ift
                $position += $new_offset;
            }

            # Prepare for next iteration.
            $n -= 1;
            $k -= 1;
        }
    }

    # Construct the partition step-by-step from the starting point.
    my @part = (1);
    foreach my $com (@commands) {
        if ($com == 1) {
            # Going from n-1,k-1 to n,k : tack on a 1.
            push @part,1;
        } else {
            # Going from n-k, k to n,k: add one to each item.
            @part = map {$_ + 1} @part;
        }
    }

    # Transform to distinct values before returning.
    @part = map { $part[$_] + $adjust[$_] } (0..@adjust-1);
    return @part;
}

# Initialize corner of the triangle.
my $p1 = zeroes $entrymax;
$p1(0) .= 1;   # Single item with a max entry of one.
$triangle{1,1} = $p1;
$p{1,1} = zeroes $entrymax2;   # Starting point for partition generati
+on.

# Use the recurrence relation to populate the triangle,
# but accumulate for each maximum number separately so
# we can shift off and eliminate cases that would take
# our maximum entry over 100.
for $n (2..$nmax) {
    for $k (1..$kmax) {
        my $psum = zeroes $entrymax;
        my $pboth = zeroes $entrymax2;
        # We'll need totals interspersed for best partition generation
+.
        my $even = $pboth(0:-1:2);
        my $odd = $pboth(1:-1:2);
        if (exists $triangle{$n-1,$k-1}) {
            # New entries for this case are created by tacking
            # on a one to each result, so the maximum is unchanged.
            my $p1 = $triangle{$n-1,$k-1};
            $odd .= $p1;
            $psum += $p1;
        }
        if (exists $triangle{$n-$k, $k}) {
            # New entries for this case are created by adding
            # a one to each entry, so shift all counts up one place.
            my $p2 = shiftpdl($triangle{$n-$k, $k});
            $even .= $p2;
            $psum += $p2;
        }

        # Interleaves the two sources of entries so we can find
        # them in an interesting order.
        $p{$n,$k} = cumusumover $pboth;
        $triangle{$n,$k} = $psum;
    }
}

my $sum = sumover $triangle{$nmax,$kmax};
print "Total unique partitions Q(677,10) on {1..100} is ",$sum,"\n";

# Now try to generate some partitions.
my @gen0 = generate($nmax,$kmax,0);
print "First one: ",join(q{ },@gen0),"\n";
my @gen1 = generate($nmax,$kmax,1);
print "Second one: ",join(q{ },@gen1),"\n";
my @gen2 = generate($nmax,$kmax,2);
print "Third one: ",join(q{ },@gen2),"\n";
my @genmax = generate($nmax,$kmax,$sum-1);
print "Last one: ",join(q{ },@genmax),"\n";
my @gennxt = generate($nmax,$kmax,$sum-2);
print "Next to last one: ",join(q{ },@gennxt),"\n";
my @genmid = generate($nmax,$kmax,int($sum/2));
print "Middle one: ",join(q{ },@genmid),"\n";

[Limbic~Region]

tall_man,
Quite impressive. It does not come near to being what I had hoped for but that is my fault. I was so close to the problem that I could not see the forest through the trees. I naively assumed that counting the ways would mean generating them and as you and others have shown - this is a very poor assumption.

I am very happy that you have contributed though because not only do I know a little bit more about math theory, I have a new way of looking at problems.

[tall_man]

My second script can be used to generate all the partitions, just by running it for each index up to the count. You could even wrap it in an iterator, just like that Partitions::Unrestricted package you wrote a while ago.