Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

(Golf as well): List of Partitions

by jynx (Priest)
on May 06, 2001 at 10:49 UTC ( [id://78334]=perlquestion: print w/replies, xml ) Need Help??

jynx has asked for the wisdom of the Perl Monks concerning the following question:


With the recent golf events lately, i've been diving back into some number theory. The one part that always most amazed me were partitions. Oddly enough, i scoured the web looking for a formula to produce a list of the partitions for a number, and came up emtpy handed. This post is in SOPW becuase this algorithm isn't correct yet, but when finished it should be a decent go.

Let's start with some code:

sub P { # This is so that we don't go off the deep end with recursion : ) return [1,1] if $_[0]==1&&$_[1]==1; return [1] if $_[0]==1; # If there's only one argument, return a list of lists containing # the argument and it's partitions. if (@_==1) { return [@_], P($_[0]-1,1) # Otherwise return a list of lists containing the arguments and # the partitions of the opposites. } else { return [@_], map({ [@$_, $_[1]] } P($_[0])), map({ [$_[0], @$_] } P($_[1])) } }
So firstly, the problem i'm having with the algorithm is that it doesn't return the else lists correctly. In particular it doesn't return the original [@_] part of the list. This is made obvious by running it and finding that the code returns a list including (for 5):
5 4 1 3 1 1 2 1 1 1 1 1 1 1 1 And many duplicates (which i handle seperately)
Note how <bold>3 2</bold> did not show up. Although Part(2) gets called, it's not returning correctly, or so it seems. i've tried to loop trace on paper, stepping through each recruse, but i think i missed something, because it should work.

Any enlightenment would be most helpful with this, yet again, after days of work, i'm blinded...



Golf: Create a subroutine (or set of subroutines) that returns a list of partitions of a number n.

My entry (which is rather long) is above if included with this snippet for removing duplicates (which could probably also be optimized). Currently i weigh in at a whopping 235 characters (without whitespace) if the following is included:

sub u{map{[split//,$_]}sort{$b cmp$a}keys%{{map{my$t=join'',@$_;$t=>1} +@_}}}
nuf evah,
jynx

Replies are listed 'Best First'.
Re (tilly) 1: (Golf as well): List of Partitions
by tilly (Archbishop) on May 06, 2001 at 16:32 UTC
    Occasionally I wish I hadn't given away most of my math books, this is one of those occasions. I had a book with lots about partitions in it, but I long ago gave it away. However this problem is quite doable. The trick is to make P a function of 2 variables, first the number n you are interested in partitioning, and then the number i that is the largest number you are willing to partition it into.

    With that tip, here is an answer in 90 characters:

    sub P { my($n,$i)=@_;$i||=$n;$i-1?map{my$c=$_;map[($i)x$c,@$_],P($n-$c*$i,$i-1 +)}0..$n/$i:[(1) x$n] }
Re: (Golf as well): List of Partitions
by danger (Priest) on May 06, 2001 at 13:15 UTC

    Well, if I'm allowed to generate a list of strings rather than a list of lists, then I'll kick off the golfing with a strict compliant one in 70 characters (inside of P):

    #!/usr/bin/perl -w use strict; sub P { my($i)=@_;push@_,grep!/[^1-$i]/,map"$i$_",P($_[0]-$i)and$i--while$i;@_ } for(P(5)){ print "$_\n"; } __END__ # output is 5 41 32 311 221 2111 11111

    If you do insist on a list of lists, we can tack on the following 16 character wrapper sub to call instead of P:

    sub W{map{[split//]}&P}

    Update: In response to my major oversight that tilly's followup points out, all I can say is:
    "Rats! Last time I go golfing in the middle of the night!"
    :-)

    Update2:Ok, in the light of day, here's a recursive one in 82 chars (ignoring unnecessary whitespace) that returns a list of lists:

    sub P{ my$i=my$n=pop; push@_,grep{!grep{$_>$i}@$_}map{[$i,@$_]}P($n-$i)while$i-->1; [$n],@_ }
      Cute idea, but your output from P(11) is..ambiguous.

      And P(12) has the incorrect "1011" entry for 10, 11.

      UPDATE
      Nice improvement. It can indeed be compressed. Here is 74 characters:

      sub P{ my$n=pop;[$n],map{my$i=$_;grep{!grep$_>$i,@$_}map[$i,@$_],P($n-$i)}1.. +$n-1 }

        Hmm, and we can shave that down to 71 chars:

        sub P{ [@_],map{my$i=$_;grep{!grep$_>$i,@$_}map[$i,@$_],P($_[0]-$i)}1..$_[0]- +1 }
Re: (Golf as well): List of Partitions
by Masem (Monsignor) on May 06, 2001 at 16:54 UTC
    Here's one that is 65 characters, returns as array of arrays, but has duplicates (though the orders are unique).
    sub P { $_[0]?map{my$c=$_;map[$c,@$_],P($_[0]-$c)}(1..$_[0]):[] }
    Update: Same thing, but avoids repetitions: Total chars: 96
    sub P { my$b=$_[1]||$_[0]; $_[0]?map{my$c=$_;map[$c,@$_],P($_[0]-$c,$c)}grep{$_<=$b}(1..$_[0]):[] }

    Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain
      The first is a non-solution in my books, but the second is very good. But I was wondering if it was possible to do a reasonable non-recursive solution, and at 87 by my count, 94 counting the body, it seems like the best so far.
      sub P{ $n=pop;@a=[0];map{$i=$_;push@{$a[$i+$_]},map[$i,@$_],@{$a[$_]}for 0..$n}1..$n;@{$a[$n]} }
      I keep on thinking this should be improvable, but darned if I can see it.
(tye)Re: (Golf as well): List of Partitions
by tye (Sage) on May 07, 2001 at 19:12 UTC

    Rule #7 for sociopathic obsessive compulsives is "If you can't win, change the rules".

    So here is a context-free iterator that produces all unique partitionings along with a golfed version of it:

    #!/usr/bin/perl -w use strict; sub ipart { my( @a, $n )= @_; while( $n++, 0 == --$a[$#a] ){ $n += pop @a; return if ! @a; } do { push @a, @a && $a[$#a] < $n ? $a[$#a] : $n; $n -= $a[$#a]; } while( 0 < $n ); return @a; } sub ip { my(@a,$n)=@_;$n+=shift@a while$n++,@a&&!--$a[0]; {@a||last;@a=($a[0]<$n?$a[0]:$n,@a);($n-=$a[0])&&redo}@a } for( @ARGV ) { print "$_:\n"; my @p= $_; do { print " [",join(",",@p),"]\n"; } while( @p= ipart( @p ) ); print "$_:\n"; @p= $_; do { print " [",join(",",@p),"]\n"; } while( @p= ip( @p ) ); }
    The advantage of a "context-free iterator" is that you can compute all possible partitions for really large numbers without running out of memory. They also tend to be pretty fast.

    An iterator returns partitionings one at a time. "Context-free" means that all you have to pass subsequent calls to the iterator is the previously returned iterator.

    Normally the first call to the iterator is a special case that initializes it and returns the first solution. In this case I cheat a little since ipart($n) looks like an initialization but can also be considered as passing in the first solution, I just start by returning the second solution.

    Anyway, feel free to golf that down from the 104-character version I came up with (since the newline is not required).

            - tye (but my friends call me "Tye")

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://78334]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (3)
As of 2024-03-19 07:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found