#!/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"; ##```## #!/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 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/2; if (\$pos > 1) { my \$accum = cumusumover \$triangle{\$n-\$k,\$k}; my \$new_offset = \$accum->at(\$pos-2); # account for shift \$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 than one"); assert(exists \$triangle{\$n-1,\$k-1}, "triangle(n-1,k-1) must 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 shift \$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 generation. # 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"; ```