#!/usr/bin/perl
use strict;
use warnings;
use List::Util 'sum';

my $group = ['A' .. 'E'];
my $size  = 3;
my ($rank_sub, $unrank_sub) = gen_ranks($group);

my $comb_iter = combo($size, @$group);
while (my @comb = $comb_iter->()) {
    my $iprt_iter = intpart($size);

    while (my @ipart = $iprt_iter->()) {
        my $part_iter = partition([@ipart], @comb);

        while (my @part = $part_iter->()) {
            print join '', map "[@$_] ", @part;
            print "\n";

            for (@part) {
                my $rank = $rank_sub->($_);
                my @team_from_rank = $unrank_sub->($rank);
                print "\tTeam: @$_\n";
                print "\tRank: $rank\n";
                print "\tRevd: @team_from_rank\n";
                print "\n";
            }
            print "\n\n\n";
        }
    }
}

# Idea from [id://581697]
sub gen_ranks {
    my $all = shift @_;
    my %pow_of_2 = map { $all->[$_] => 2 ** $_ } 0 .. $#$all;
    my %rev = reverse %pow_of_2;
    return (
        sub {
            my $team = shift @_;
            return sum(map {$pow_of_2{$_}} @$team);
        },
        sub {
            my $rank = shift @_;
            my @team;
            for (sort {$b <=> $a} keys %rev) {
                if ($_ <= $rank) {
                    $rank -= $_;
                    unshift @team, $rev{$_};
                }
                last if ! $rank;
            }
            return @team;
        },
    );

}

# From [id://533530]
sub partition {
    my @block_size = sort { $a <=> $b } @{ shift(@_) };
    my @items = @_;    
    @items == sum @block_size or die "sum of block sizes must equal nu
+mber of items";
    my @rg;
    return sub {
        if ( !@rg ) {
            @rg = map { ($_) x $block_size[$_] } 0 .. $#block_size;
        } elsif ( ! next_rg_perm(\@rg) ) {
            next_permute(\@block_size) or return;
            @rg = map { ($_) x $block_size[$_] } 0 .. $#block_size;
        }
        my @return;
        push @{ $return[ $rg[$_] ] }, $items[$_] for 0 .. $#items;
        return @return;
    };
}

# From [id://533530]
sub next_rg_perm {
    my $vals = shift;
    my ($candidate, @avail);
    my $i = @$vals;
    while (--$i) {
        ($candidate) = grep defined, @avail[ $vals->[$i]+1 .. $#avail 
+];
        last if  defined $candidate
             and grep { $_ >= $vals->[$candidate]-1 } @$vals[0..$i-1];

        $avail[ $vals->[$i] ] = $i;
    }
    return if $i == 0;
    
    @$vals[$i, $candidate] = @$vals[$candidate, $i];
    @$vals[$i+1 .. $#$vals] = sort { $a <=> $b } @$vals[$i+1 .. $#$val
+s];
    return 1;
}

# From [id://533530] adapted from tye's [id://29374]
sub next_permute {
    my $vals = shift;
    return if @$vals < 2;
    my $i = $#$vals - 1;
       $i-- until $i < 0 or $vals->[$i] < $vals->[$i+1];
    return if $i < 0;
    @$vals[ $i+1 .. $#$vals ] = reverse @$vals[ $i+1 .. $#$vals ];
    my $j = $i+1;
       $j++ until $vals->[$i] < $vals->[$j];
    @$vals[$i,$j] = @$vals[$j,$i];   
    return 1;
}

# From [id://393792]
sub intpart {
    my $target = shift;
    return sub { () } if ! $target || $target =~ /\D/;
    my @part = (0, (1) x ($target - 1));
    my $done = undef;
    return sub {
        return () if $done;
        my $min = $part[-2];
        my $total = $part[0] ? 0 : 1;
        my $index = 0;
        for (0 .. $#part - 1) {
            if ($part[ $_ ] > $min) {
                $total += $part[$_]; 
                next;
            }
            $index = $_;
            last;
        }
        $part[$index]++; 
        $total += $part[$index];
        if ($total > $target || $part[$index] > $part[0]) {
            @part = ($index ? ++$part[0] : $part[0], (1) x ($target - 
+$part[0]));
        }
        else {
            @part = (@part[0 .. $index], (1) x ($target - $total));
            push @part, 1 if $part[0] == 1;
        }
        $done = 1 if $part[0] == $target;
        return @part;
    }
}

# From [id://393064]
sub combo {
    my $by = shift;
    return sub { () } if ! $by || $by =~ /\D/ || @_ < $by;
    my @list = @_;
    my @position = (0 .. $by - 2, $by - 2);
    my @stop     = @list - $by .. $#list;
    my $end_pos  = $#position;
    my $done     = undef;
    return sub {
        return () if $done;
        my $cur = $end_pos;
        {
            if ( ++$position[ $cur ] > $stop[ $cur ] ) {
                $position[ --$cur ]++;
                redo if $position[ $cur ] > $stop[ $cur ];
                my $new_pos = $position[ $cur ];
                @position[ $cur .. $end_pos ] = $new_pos .. $new_pos +
+ $by;
            }
        }
        $done = 1 if $position[0] == $stop[0];
        return @list[ @position ];
    };
}
[download]