Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
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";

In reply to Re: Challenge: Number of unique ways to reach target sum by tall_man
in thread Challenge: Number of unique ways to reach target sum by Limbic~Region

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others meditating upon the Monastery: (15)
    As of 2014-11-24 20:38 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My preferred Perl binaries come from:














      Results (147 votes), past polls