[SPOILER] Medium QOTW 1 solution

Daniel Martin <martin-+m399P62/[email protected]> Mon, 17 Jan 2005 16:47:16 -0500

Newsgroups	gmane.comp.lang.perl.qotw.discuss
Message-ID	<[email protected]>

Well, it appears that my building a verifier was for naught, since by
the time I had posted mine a more complete version had been posted by
the quiz author, but here's a solution approach which I don't think
has been tried before.

First off, I did as was suggested in the problem and solved the case
when N is a power of 2 separately - there's a very short solution
available in that case, that unfortunately does not generalize to
other N at all.

Then, I tried to attack the problem recursively - if I had a
tournament sheet for a tournament of N teams, what other size
tournaments could be constructed?

Well, it turns out that it's fairly easy to construct a tournament for
2*N teams: just split the teams into two brackets, have each bracket
play the tournament of size N among themselves, and then have N days
in which you match teams from different brackets.  The last N days are
handled by having team $a in the lower bracket play team $a + $d in
the upper bracket, for $d in 0..N-1.  (Assuming the teams are renumbered
within each bracket, and with the appropriate % $whatever thrown into
the expression)

Now, going from 2*N to 2*N-2 is a bit trickier.  The teams are split
into two brackets as before, and a ghost team is added to each
bracket.  (So that each bracket has N teams, including the ghost)
Then, each bracket plays the tournament of size N, but each team that
would play the ghost team instead plays the corresponding team in the
other bracket.  The last N-2 days are then filled as before, except
that $d is restricted to the range 1..N-2.

Of course, this is all shamed by the simplicity of Zsban Ambrus's
algorithm, but it was already written, so I'll post it anyway.

dtmQ1Y2005.pl (text/x-perl, 1.7 KB)

#!/usr/bin/perl
use strict;

# two nice utility functions that deal with array refs
sub concat ($$) {
  return [ @{$_[0]}, @{$_[1]} ];
}
# i.e. "map with arrayrefs"
sub mapr (&$) { return [ map {$_[0]->();} @{$_[1]} ]; }

# given a tournament for n players, give us a tournament
# for 2*n players
sub double_prev_solution ($) {
  my $prevsolution = $_[0];
  my $halfn = scalar(@$prevsolution) + 1;
  my $n = $halfn*2;
  return concat(
    (mapr {concat($_, mapr {$_+$halfn} $_)} $prevsolution),
    mapr {
      my $d=$_;
      my $s = mapr {(($_+$d) % $halfn) + $halfn} [0..$halfn-1];
      my $t = mapr {($_-$d) % $halfn} [$halfn..$n-1];
      concat($s, $t)
    } [0..$halfn-1]
  );
}

# given a tournament for n players, give us a tournament
# for 2*n-2 players
sub double_min_2_prev_solution ($) {
  my $prevsolution = $_[0];
  my $halfn = scalar(@$prevsolution);
  my $n = $halfn*2;
  return concat (
    (mapr {
      my $s = [ @$_ ];
      $s->[$s->[$halfn]] = $halfn + $s->[$halfn];
      pop @$s;
      concat($s, mapr {($_+$halfn) % $n} $s)
    } $prevsolution),
    mapr {
      my $d=$_; 
      my $s = mapr {(($_+$d) % $halfn) + $halfn} [0..$halfn-1];
      my $t = mapr {($_-$d) % $halfn} [$halfn..$n-1];
      concat($s, $t)
    } [1..$halfn-1]
  );
}

sub allocate_schedule ($) {
  my ($n) = @_;
  if ($n % 2 != 0) {die "Not an even number of teams!";}
  if (($n & ($n-1)) == 0) {
    # power of 2 - special-case this
    return mapr {
        my($a) = $_;
	mapr {$a^$_} [0..$n-1]
      } [1..$n-1];
  }
  # otherwise, determine if we are a multiple of 4 or not
  if ($n % 4 == 0) {
    return double_prev_solution(allocate_schedule($n/2));
  } else {
    return double_min_2_prev_solution(allocate_schedule(1 + $n/2));
  }
}