Re^2: Combinatorics problem.


Pathologically Eclectic Rubbish Lister
	PerlMonks

Re^2: Combinatorics problem.

by Anonymous Monk

on Dec 11, 2015 at 10:39 UTC ( [id://1150010]=note: print w/replies, xml )

Need Help??

in reply to Re: Combinatorics problem.
in thread Combinatorics problem. (Updated with more info.)

hacky solution :)

## usage example:
## program.pl -cards 5 -holes 3

use strict;
use warnings;

use feature 'say';

use Getopt::Long;
use Algorithm::Combinatorics 'combinations';

main();
exit 0;

sub main {
    GetOptions(
        'cards=i' => \my $cards,
        'holes=i' => \my $holes
    );
    die unless $cards and $holes;
    # TODO: more robust error checks
    # for now let's just assume that the user is sane :)

    $cards -= $holes;

    my $tot = $cards + $holes - 1;
    my $combos = combinations( [ 0 .. $tot - 1 ], $cards );

    while ( my $combo = $combos->next() ) {
        my $hack = '0' x $tot;    # total hack! :)

        for my $c (@$combo) {
            substr( $hack, $c, 1, '1' );
        }

        say join ', ', map length() + 1, split /0/, $hack, -1;
    }
}
[download]

example:

$ perl buk.pl -c 12 -h 7 | wc -l
462
[download]

Comment on Re^2: Combinatorics problem. Select or Download Code

Replies are listed 'Best First'.

Re^3: Combinatorics problem.
by Anonymous Monk on Dec 11, 2015 at 11:37 UTC

## usage example:
## program.pl -cards 5 -holes 3

use strict;
use warnings;

use feature 'say';

use Getopt::Long;
use Algorithm::Combinatorics 'combinations';

main();
exit 0;

sub main {
    GetOptions(
        'cards=i' => \my $cards,
        'holes=i' => \my $holes
    );
    die "Usage: $0 -c CARDS -h HOLES\n"
      if !defined($cards)
      || !defined($holes)
      || $cards <= 0
      || $holes <= 0
      || $cards < $holes;

    $cards -= $holes;

    my $tot = $cards + $holes - 1;
    my $combos = combinations( [ 0 .. $tot - 1 ], $cards );

    while ( my $combo = $combos->next() ) {
        my @result = (1) x $holes;

        for my $i ( 0 .. @$combo - 1 ) {
            $result[ $combo->[$i] - $i ] += 1;
        }

        say join ', ', @result;
    }
}
[download]

[reply]
[d/l]

In Section Seekers of Perl Wisdom

Domain Nodelet^?

www.com | www.net | www.org

Node Status^?

node history
Node Type: note [id://1150010]
help

Chatterbox^?

How do I use this? • Last hour • Other CB clients

Other Users^?

Others surveying the Monastery: (5)

As of 2024-04-23 17:35 GMT

Sections^?

Information^?

Find Nodes^?

Leftovers^?

Today I Learned

Voting Booth^?

No recent polls found