Yes, yes, this has been done before (hasn't everything?), but I think this still comes out to be the most compact method to actually calculate and display partitions of integers. The previous thread had people just trying to calculate them in memory. This one takes a single integer on the command line and goes to town.


sub p{my($n,@e,$o)=@_;print if!$_{$_=join$",sort@_,$/}++;p(++$o,--$n,@
+e)while$n-1}p(shift)

[download]

90 characters! woo hoo! I only beat tilly's solution by 1 character, once I appended print@$_,$/for P(shift) to it. A more compact printer added on to it would render that one the winner.

Update: Ya know, one of these days, my golf game'll be good enough that I'll post and someone won't immediately respond and say "I can shave off another character!" heh. Props to liverpole and blazar. I incorporated their suggestions, plus another one I thought of to drop down to 83.


sub p{my($n,@e,$o)=@_;$_{$_=join$",sort@_,$/}++||print;p(++$o,$n,@e)wh
+ile--$n}p pop

[download]

Update 2: And 80


sub p{my(@e,$o)=@_;$_{$_=join$",sort@_,$/}++||print;p(++$o,@e)while--$
+e[0]}p pop

[download]

I'm pretty proud of this one. I think my golf game is improving. As always, let's reformat for clarity.


sub p{
    my($n,@e,$o) = @_;
    print if ! $_{$_ = join$",sort@_,$/}++;
    p(++$o, --$n, @e) while $n-1;
}
p(shift)

[download]

This one's so tight it's gonna be a real bitch to explain. it's a recursive function, and each sub-call hands in one less than the number it previously had, in addition to a counter counting up to where it previously was, plus any other arguments it had received. I'll walk this through in a bit.


my($n,@e,$o) = @_;

#note this is the same as:
my $n = $_[0];
my @e = @_;
my $o;

[download]

print if ! $_{$_ = join$",sort@_,$/}++;

[download]

This is the bulk of the magic. Internally, it pulls in and sorts the arguments it was handed. So, for example, if we're partitioning 15, on one call this function would receive (11,2,1,1) (in some order). So here we sort it (1,1,2,11) along with $/ (input record terminator, defaults to "\n", invaluable for obfuscations). This has the unfortuate side effect of printing the newline first, then the output, but que sera sera.

It's sorted so that we can subsequently return with the same arguments in a different order but not reprint. It assigns that sorted business to $_, and uses the whole ball of wax as a hash key which it post-increments.

We then call print w/o arguments (defaults to $_, which we just assigned back in that hash key), only if the value of the key in the hash == 0. That is, only the first time that string is encountered. This prevents duplicates.

We then recurse. We hand off an arbitrary counter that constantly goes up, our original number, decremented, and anything else we were originally handed in. Repeat as long as the number exists.

Sample runthrough: (unless I inserted a logic error)


p(5)
  outputs 5
  calls p(1,4)
    outputs 1,4
  calls p(2,3)
    outputs 2,3
    calls(1,1,3)
    outputs 1,1,3
  calls p(3,2)
    calls(2,2,1)
      outputs 1,2,2
      calls(1,1,2,1)
        outputs 1,1,1,2
  calls p(4,1)
    calls p(3,2,1)
      calls p(2,2,1)
        calls p(1,1,2,1)
      calls p(2,1,1,1)
        calls p(1,1,1,1,1)
          outputs 1,1,1,1,1

[download]

Replies are listed 'Best First'.
Re: integer partition golf
by liverpole (Monsignor) on Oct 18, 2006 at 20:55 UTC
    <homer simpson voice>Mmmmmmm ... gollllf ....</homer simpson voice>

    Can I play too? 

    #  1.  Convert "shift" to "pop" to save 2 chars
#  2.  Convert leading "if" to trailing "&&" to
#      squeeze out one space char
#  3.  Convert !(conditional)&&(action) to
#      (conditional)||(action) for one char
#
#  Savings = 4 chars (86 total chars)

sub p{my($n,@e,$o)=@_;$_{$_=join$",sort@_,$/}++||print;p(++$o,--$n,@e)
+while$n-1}p(pop)

    [download]

    I've a feeling it can go smaller, though :)

    Update  Oh, and ... 

    #  4.  Remove parens from subroutine for 1 char
#
#  Total:  85 chars

sub p{my($n,@e,$o)=@_;$_{$_=join$",sort@_,$/}++||print;p(++$o,--$n,@e)
+while$n-1}p pop

    [download]

    I still think it can get smaller ...

    s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/
[reply]
[d/l]
[select]
Re: integer partition golf
by liverpole (Monsignor) on Oct 19, 2006 at 00:57 UTC
    Hi jimt,

            Ya know, one of these days, my golf game'll be good enough that I'll post and someone won't immediately respond and say "I can shave off another character!"

    No, my hat's off to you ... and you gotta give yourself a LOT of credit.

    First, you came up with the original challenge, which was fun.  And even though blazar and I stripped off 5 characters, you stripped off 5 more!

    As I'm sure you're aware, that's a much bigger feat, since getting just a single character here and there gets harder and harder.

    I don't think it can go much lower.  I can only see a 1-character savings at this point, for 79: 

    sub p{my(@e,$o)=@_;$_{$_=join$",sort@_,$/}||=print;p(++$o,@e)while--$e
+[0]}p pop

    [download]
    s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/
[reply]
[d/l]
      I don't think it can go much lower. I can only see a 1-character savings at this point, for 79: 
      sub p{my(@e,$o)=@_;$_{$_=join$",sort@_,$/}||=print;p(++$o,@e)while--$e
+[0]}p pop

      [download]

      I second that.

      I don't think it can go much lower. I can only see a 1-character saving at this point, for 78: 

      sub p{my(@e,$o)=@_;$_{$_="@{[sort@_]}\n"}||=print;p(++$o,@e)while--$e[
+0]}p pop

      [download]

      :-)

      That fixes the leading $/, too.

      --shmem 

      _($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                              /\_¯/(q    /
----------------------------  \__(m.====·.(_("always off the crowd"))."·
");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}
[reply]
[d/l]
[select]
        Chopped on more char.....
        sub p{my(@e,$o)=@_;${$_="@{[sort@_]}\n"}||=print;p(++$o,@e)while--$e[0]}p pop
[reply]
[d/l]
Re: integer partition golf
by blazar (Canon) on Oct 18, 2006 at 21:14 UTC

    You can still save 5 chars without changing your logic, but adopting a pair of common golf tricks:

    sub p{my($n,@e,$o)=@_;$_{$_=join$",sort@_,$/}++||print;p(++$o,--$n,@e)while$n-1}p pop
[reply]
[d/l]

Back to Obfuscated Code