[pimento:~] simonm% perl -w /tmp/t.pl 1 2 3
Competing: 3 schools, 6 entrants
Structure: 3 rounds of 3 panels
Panel Size: 2 entries each
Calculation: required 5 attempts in 0 seconds

Teams:
- A1
- B1, B2
- C1, C2, C3

Round 1:
- B2, C3
- C1, B1
- C2, A1

Round 2:
- C3, B1
- A1, C1
- B2, C2

Round 3:
- C2, B1
- A1, C3
- C1, B2

perl -w /tmp/t.pl 3 3 3 3 3 3 3 3 3 3
Competing: 10 schools, 30 entrants
Structure: 3 rounds of 6 panels
Panel Size: 5 entries each
Calculation: required 1062 attempts in 12 seconds

Teams:
- A1, A2, A3
- B1, B2, B3
- C1, C2, C3
- D1, D2, D3
- E1, E2, E3
- F1, F2, F3
- G1, G2, G3
- H1, H2, H3
- I1, I2, I3
- J1, J2, J3

Round 1:
- B2, C2, D1, J2, A2
- C3, I2, H3, J3, G3
- E1, F1, I1, B3, A3
- F3, B1, H1, C1, G2
- E3, H2, F2, D2, A1
- D3, E2, J1, G1, I3

Round 2:
- A1, G1, C3, B1, J2
- D3, A2, J3, I1, H2
- B3, H1, I3, G3, D2
- E2, A3, H3, F3, C2
- E3, J1, C1, F1, B2
- G2, F2, D1, I2, E1

Round 3:
- F1, H1, I2, E2, J2
- B1, A2, G3, J1, F2
- I3, C2, E1, J3, A1
- C1, H2, A3, D1, G1
- B3, C3, F3, D3, E3
- I1, G2, D2, H3, B2


##</code><code>##

use strict;

### Constants

my $number_of_rounds = 3;
my $max_per_panel = 6;
my $max_per_team = 3;

# Make this number bigger to get better results at the cost of running slower
my $attempts_before_enlarging_panels = 1000; 

### Parse Arguments

unless ( scalar @ARGV ) {
  print "Usage: pass the number of participants from each team as arguments\n";
  exit;
}
my @entrants = @ARGV;

### Build Teams

my %teams;
my $team_id = 'A';
foreach my $count ( @entrants ) {
  die "Too many people on team $team_id: $count" if ( $count > $max_per_team );
  foreach my $j ( 1 .. $count ) {
    $teams{$team_id}->[ $j - 1 ] = "$team_id$j";
  }
  $team_id ++;
}

my @participants = map { @$_ } values %teams;

### Declare Result Variable

my @rounds;
my $start_time = time();
my $attempts = 1;

### Determine Panel Size

my $panels_required = int( .99 + scalar(@participants) / $max_per_panel );
$panels_required = $max_per_team if ( $panels_required < $max_per_team );

PANEL_EXPANSION: {
  
  my $base_per_panel = int( scalar(@participants) / $panels_required );
  my $oversize_panels = scalar(@participants) - ($panels_required * $base_per_panel );
  my $most_per_panel = $base_per_panel + ( $oversize_panels ? 1 : 0 );
  my @panel_sizes = ( 
      ( $oversize_panels ? ( $most_per_panel ) x $oversize_panels : () ),  
      ( $base_per_panel ) x ( $panels_required - $oversize_panels )
  );

### Attempt to Build Panels 

  ATTEMPT: {
    
    # The "zero round" contains the teams themselves
    @rounds = [ map $teams{$_}, sort keys %teams ];
    foreach my $round ( 1 .. $number_of_rounds ) {
      # warn "Building round $round\n";
    
      my %exclusions;
      foreach my $panel ( map @$_, @rounds ) {
        foreach my $a ( @$panel ) {
          foreach my $b ( @$panel ) {
            $exclusions{$a}->{$b} = 1;
          }
        }
      }
    
      # warn "Should exclude: " . join(', ', map { my $a = $_; map "$a-$_", sort keys %{$exclusions{$a}} } sort keys %exclusions) . "\n";
    
      my @available = @participants;
      my @panels;
      foreach my $panel ( 1 .. $panels_required ) {
        # warn "  Building panel $panel ($panel_sizes[$panel - 1])\n";
        my @entries;
        foreach ( 1 .. $panel_sizes[$panel - 1] ) {
          last unless scalar @available;
          my %exclude = map { $_ => 1 } 
                                map { sort keys %{$exclusions{$_}} } @entries;
          # warn "      Avoiding " . join(', ', sort keys %exclude) . "\n";
          my @candidates = ( grep { ! $exclude{$_} } @available ) or do {
            # warn "Can't find a candidate in: " . join(', ', @available);
            if ( $attempts ++ % $attempts_before_enlarging_panels ) {
              # warn "Trying again..."
              redo ATTEMPT;
            } else {
              # warn "This is taking too long; expanding number of panels...";
              $panels_required ++;
              redo PANEL_EXPANSION;
            }
          };
          my $candidate = $candidates[ int rand scalar @candidates ];
          # warn "    Selecting $candidate\n";
          push @entries, $candidate;
          @available = grep { $_ ne $candidate } @available;
        }
        # @entries = map $teams{$_}->[$panel - 1], sort keys %teams;
        $panels[$panel - 1] = \@entries;
      }
      $rounds[$round] = \@panels;
    }
  }

### Display Competition Info

  print "Competing: " . scalar(@entrants) . " schools, " . 
                        scalar(@participants) . " entrants\n";
  print "Structure: $number_of_rounds rounds of $panels_required panels\n";
  print "Panel Size: $most_per_panel entries " . ( $oversize_panels ? 
        "or less (" . join(', ', @panel_sizes) . ")" : 'each' ) . "\n";
  print "Calculation: required $attempts attempts in " . 
        ( time - $start_time ) . " seconds\n";
  
}

### Display Teams and Rounds

foreach my $round ( 0 .. $#rounds ) {
  print( "\n" . ( $round ? "Round $round" : "Teams" ) . ":\n" );
  my @panels = @{ $rounds[$round] };
  foreach my $panel ( @panels ) {
    print( "- " . join(', ', @$panel) . "\n" )
  }
}