#!/usr/local/bin/perl -w

# TODO: check that ratings are calculated correctly with RRs
# TODO: make games count against director

# tourney.pl - perform Scrabble tournament calculations

# Copyright (C) 1996 by John J. Chew, III <jjchew@math.utoronto.ca>
# All Rights Reserved

# Input File Format
#
# One line per player, reading:
#
#   name rating rr pairings ; scores
#
# e.g.
#
#   John Chew 1823*75 R2/7.5/+30 1 2 3 0 ; 400 450 350 50 # comment
#
# meaning that John Chew was
#   rated 1823 before this tournament
#   played a double round robin and won 7.5 games with a +30 spread
#   played three additional games
#     scoring 400 against player #1, 450 against player #2,
#     350 against player #3
#   and had a 50-point bye
#
# name: given name(s) followed by surname
# rating: pre-tournament rating, followed optionally by an asterisk and the
#   number of games on which the rating is based, or by two asterisks to
#   indicate that the rating is fixed (as e.g. for a Club #3 director)
# rr: round robin information (optional), if present prevents scoring
#   statistics from being calculated.  must be a capital 'R' followed by
#   number of round robins, games won and spread, separated by '/'s.
# pairings: opponent numbers; first in file is 1, bye is 0.
# scores: player's scores; opponent's scores are found on opponent's lines.

sub Usage {
  die "Usage: $0 [-A] [-C] [-d r] [-f] [-S] [-c|-n|-r|-s pn|-v] file...\n"
     ."  -A     do not use acceleration or feedback points\n"
     ."  -c     output in Club #3's format\n"
     ."  -C     use club tournament multipliers\n"
     ."  -d r   divide tournament after round r for ratings purpose\n"
     ."  -f     use fixed player ids\n"
     ."  -n     output NSA ratings input files\n"
     ."  -r     output regular readable reports\n"
     ."  -s pn  output a scoresheet for a player specified by number\n"
     ."  -S     suppress scores\n"
     ."  -v     display version number of this script\n"
     ;
  }

## include libraries

unshift(@INC, "$ENV{'HOME'}/lib/perl") if defined $ENV{'HOME'};

require 'getopts.pl';
require 'ratings.pl';
require 'ratings2.pl';

## parse command line

# Macintosh stuff
# @ARGV = ('-f','c.in'); open(OUT, ">c.out") || die "can't create c.out";
# select(OUT); &MacPerl'SetFileInfo('MSWD','TEXT','c.out');
@argv = split(/:/, $0); @argv = split(/\s+/, pop @argv);
shift(@argv); unshift(@ARGV, @argv);

$opt_A = 0;
$opt_C = 0;
$opt_f = 0;
&Getopts('ACcd:fnrs:vS-:') || &Usage;
$n = 0;
defined $opt_c && $n++;
defined $opt_n && $n++;
defined $opt_r && $n++;
defined $opt_s && $n++;
defined $opt_v && $n++;
$n == 0 ? ($opt_r = 1) : $n > 1 && &Usage;

&ratings2'UseAccelerationBonuses(!$opt_A);
&ratings2'UseClubMultipliers($opt_C);
# maximum number of times to iterate when calculating initial ratings
&ratings2'SetMaximumIterations(25);

## global variables

# length of longest player name
$gNameLength   = 0;

# length of longest player ID
$gNumberLength = 2;

# version number of this script
$gVersion     = '1.1.1';

## main code

dbmopen(%ONLINE, 'online', 0600);
  if ($opt_v) { print "$0: version $gVersion.\n"; exit 0; }
  elsif ($#ARGV == -1) { &ProcessOpenFile(*STDIN); }
  else { for $ARGV (@ARGV) { &ProcessFile($ARGV); } }
dbmclose(%ONLINE);

## subroutines

# &CalculateSeeds($players)
sub CalculateSeeds { local($ps) = @_;
  local($id, $last, $lastseed, $seed) = (0, -1, 1, 0);
  for $id (sort {$ps->[$b]{'oldr'} <=> $ps->[$a]{'oldr'}} 0..$#$ps) { $seed++;
    if ($ps->[$id]{'oldr'} != $last) { $lastseed=$seed; $last=$ps->[$id]{'oldr'
}; }
    $ps->[$id]{'seed'} = $lastseed;
    }
  }

# $full_name = &Online($real_name);
sub Online { defined $ONLINE{$_[0]} ? "$_[0] ($ONLINE{$_[0]})" : $_[0]; }

# &ProcessFile($filename)
sub ProcessFile { local($filename) = @_;
  if (open(FILE, "<$filename")) { &ProcessOpenFile(*FILE); close(FILE); }
  else { warn "Can't read file \`$filename': $!\n"; }
  }

# &ProcessOpenFile(*FH);
sub ProcessOpenFile { local(*FH) = @_;
  local($players) = &ReadFile(*FH);
  defined $opt_c ? &WriteClub3($players) :
  defined $opt_r ? &WriteReport($players) :
  defined $opt_n ? &WriteNSA($players) :
    &WriteSS($players, $opt_s);
  }

# [ $player_structs ] = &ReadFile(*FH);
sub ReadFile { local(*FH) = @_;
  local($games, $l, $o, $opts, $os, $osc, $p, $pn, $ps, $pts, $round, $sc,
    $scs, $spread);

  # read players
  $ps = [];
  $gNameLength = length("Name (online)");
  while ($p = &ReadPlayer(*FH)) {
    push(@$ps, $p);
    $p->{'id'} = $#$ps;
    $os = $p->{'opps'}; $scs = $p->{'scores'};
    $l = length($p->{'fname'} = &Online($p->{'name'}));
    $gNameLength = $l if $gNameLength < $l;
    printf STDERR "%s: number (%d) of opponents (%s) "
      ."is less than number (%d) of scores (%s).\n",
      $p->{'name'}, 1+$#$os, "@$os", 1+$#$scs, "@$scs" if $#$os < $#$scs;
    }
  $gNumberLength = length(1+$#$ps);
  $gNumberLength = 2 if $gNumberLength < 2;

  # analyse and check data
  for $pn (0..$#$ps) { $p = $ps->[$pn];
    $games = 0; $opts = $pts = 0;
    $p->{'ewins'} = $p->{'hi'} = $p->{'rgames'} =
      $p->{'spread'} = $p->{'tagn'} = $p->{'tfor'} = $p->{'wins'} = 0;
    $os = $p->{'opps'};
    $p->{'games'} = $#$os + 1;
    for $round (0..$#$os) {
      $o = $os->[$round];
      $sc = $p->{'scores'}[$round];
      if ($o == -1) { # bye
        next unless defined $sc;
        $spread = $sc;
        if ($opt_c) {
          printf "%s: bye in round %d scored %+d instead of standard 0.\n",
            $p->{'fname'}, 1+$round, $p->{'scores'}[$round]
            if $p->{'scores'}[$round];
          }
        else {
          printf "%s: bye in round %d scored %+d instead of standard +-50.\n",
            $p->{'fname'}, 1+$round, $p->{'scores'}[$round]
            if $p->{'scores'}[$round]**2 != 2500;
          }
        }
      elsif ($o == $pn) {
        printf "%s: played self in round %d\n", $p->{'fname'}, 1+$round;
        next;
        }
      elsif ($o > $#$ps) {
        printf "%s: opponent number (%d) in round %d is too big.\n",
          $p->{'fname'}, $o, 1+$round;
        next;
        }
      else {
        $o = $ps->[$o];
        printf "In round %d, %s's opp was %s but %s's opp was %s.\n",
          $round+1, $p->{'fname'}, $o->{'fname'}, $o->{'fname'},
          $ps->[$o->{'opps'}[$round]]{'fname'}
          if $pn != $o->{'opps'}[$round];
        next unless defined $sc;
        $p->{'hi'} = $sc if $p->{'hi'} < $sc;
        $pts  += $sc;
        $opts += $osc = $o->{'scores'}[$round];
        $spread = $sc - $osc;
        $p->{'ewins'} += (($spread<=>0)+1)/2;
        $p->{'rgames'} ++;
        $games++;
        }
      $p->{'spread'} += $spread;
      $p->{'wins'}   += (($spread<=>0)+1)/2;
      }
    if (defined $p->{'rr'}) {
      $p->{'ewins'} += $p->{'rr'}[1];
      $p->{'rgames'} += $p->{'rr'}[0] * $#$ps;
      $p->{'spread'} += $p->{'rr'}[2];
      $p->{'wins'} += $p->{'rr'}[1];
      $opt_S = 1;
      }
    if ($games > 0) {
      $p->{'afor'} = $pts/$games;
      $p->{'aagn'} = $opts/$games;
      $p->{'tfor'} = $pts;
      $p->{'tagn'} = $opts;
      }
    else { $p->{'afor'} = $p->{'aagn'} = 0; }
    }
  $ps;
  }

# the player_struct returned by the following sub and used elsewhere
# has the following fields:
#   aagn    average points scored by opponents
#   afor    average points scored by player
#   curr    current rating during iteration of initial rating
#   ewins   earned wins (not including byes)
#   fname   full name with online id appended if any
#   games   games played (including byes)
#   hi      high game score
#   id      0-based id
#   midr    mid-tournament rating in a split-rated tournament
#   name    full name
#   newr    post-tournament rating
#   oldr    pre-tournament rating
#   opps    [ opponent ids (0-based) ]
#   rank    ranking
#   rgames  real games (not including byes)
#   rr      [ # of round robins played, wins, spread ] or undef
#   scores  [ own score in each game ]
#   spread  point spread
#   tagn    total points scored by opps
#   tfor    total points scored by player
#   totalg  number of games played prior to this tournament
#           (-1 if rating is fixed)
#   wins    games won (including byes)

# $player_struct = &ReadPlayer(FH);
sub ReadPlayer { local(*FH) = @_;
  local($games, $n, $o, @opps, $rr, $r, $s, $t, @t);
  while (<FH>) { s/#.*//; next unless /\S/;
    if (($n, $r, $games, $rr, $o, $s)
= m!^([a-zA-Z][-a-zA-Z ]+[a-zA-Z]) +(\d+)(\*\*|\*\d+)? +(R\d+/\d*\.?\d*/[+-]?\d
+ )? *([\d ]*); *([-\d ]*)$!)
      {
      if (defined $rr) { $rr =~ s/^R//; $rr = [split(/\//, $rr)];}
      for $t (@opps = split(/\s+/, $o)) { $t--; }
      return {
        name => $n,
        oldr => $r,
        rr => $rr,
        opps => \@opps,
        scores => [split(/\s+/,$s)],
        totalg =>
          (defined $games) ? ($games eq '**') ? -1 : substr($games, 1): 100
        };
      }
    else {
      warn "Can't parse (and am ignoring) the following line:\n$_";
      }
    }
  undef;
  }

# &WriteClub3($players)
sub WriteClub3{ local($ps) = @_;
  local($p, @ranked);

  &ratings2'CalculateRatings($ps, 'oldr', 1, 'newr', 10000);
  @ranked = sort {
    $b->{'newr'}   <=> $a->{'newr'} ||
    $a->{'name'}   cmp $b->{'name'}
    } @$ps;

  printf "%-${gNameLength}s   W-L   Sprd OldR NewR +-R PFor PAgn HiG\n\n",
    'Name';

  for $p (@ranked) {
    if ($p->{'games'}) {
      printf "%-${gNameLength}s %3g-%-3g",
        $p->{'fname'}, $p->{'ewins'}, $p->{'rgames'}-$p->{'ewins'};
      printf " %+4d", $p->{'spread'} unless $opt_S;
      if ($p->{'oldr'}) {
        printf " %4d %4d %+3d ", $p->{'oldr'}, $p->{'newr'}, $p->{'newr'}-$p->{
'oldr'};
        }
      else { printf " n.r. %4d     ", $p->{'newr'}; }
      printf "%4d %4d %3d", $p->{'tfor'}, $p->{'tagn'}, $p->{'hi'}
        unless $opt_S;
      print "\n";
      }
    else {
      printf "%-${gNameLength}s                   %4d\n",
        $p->{'fname'}, $p->{'newr'};
      }
    }
  }

# &WriteNSA($players)
sub WriteNSA { local($ps) = @_;
  local(@n, $o, $os, $p, $pn, $round);

  for $pn (0..$#$ps) { $p = $ps->[$pn];
    printf "%d ", $pn+1;
    @n = split(/ /, $p->{'name'});
    if ($#n != 1) {
      if ($p->{'name'} =~ /^m g ravichandran$/i) { @n = ('m g', 'ravichandran')
; }
      elsif ($p->{'name'} =~ /^john van zeyl$/i) { @n = ('john', 'van zeyl'); }
      elsif ($p->{'name'} =~ /^eugene van de walker$/i)
        { @n = ('eugene', 'van de walker'); }
      elsif ($p->{'name'} =~ /^muriel de silva$/i) { @n = ('muriel', 'de silva'
, 'muriel'); }
      else { die "Don't know how to parse: $p->{'name'}\n"; }
      }
    print "\U@n[1,0]/$p->{'spread'}:";
    $os = $p->{'opps'};
    for $round (0..$#$os) {
      $o = $os->[$round];
      if ($o == -1) { print " B"; } # bye
      else {
        print ' ',
          ('L','T','W')[($p->{'scores'}[$round]<=>$ps->[$o]{'scores'}[$round])+
1],
          $o+1;
        }
      }
    print "\n";
    }
  }

# &WriteReport
sub WriteReport { local($ps) = @_;
  local($i, $last_spread, $last_wins, $p, $rank, @ranked);

  &CalculateSeeds($ps);
  if (defined $opt_d) {
    &ratings2'CalculateRatings($ps, 'oldr', 1, 'midr', $opt_d);
    &ratings2'CalculateRatings($ps, 'midr', $opt_d+1, 'newr', 10000);
    }
  else {
    &ratings2'CalculateRatings($ps, 'oldr', 1, 'newr', 10000);
    }

  printf "Rank Seed %-${gNameLength}s Wins", 'Name (online)';
  print  "  Sprd" unless $opt_S;
  print  " OldR NewR Chng";
  print  " For Agn  Hi" unless $opt_S;
  print "\n";

  @ranked = sort {
    $b->{'wins'}   <=> $a->{'wins'} ||
    $b->{'spread'} <=> $a->{'spread'} ||
    $b->{'oldr'}   <=> $a->{'oldr'} ||
    $b->{'name'}   cmp $a->{'name'}
    } @$ps;
  $i = $rank = 1; $last_spread = $last_wins = -10000;
  for $p (@ranked) {
    if ($p->{'wins'} != $last_wins || $p->{'spread'} != $last_spread) {
      $last_wins = $p->{'wins'}; $last_spread = $p->{'spread'};
      $rank = $i;
      }
    printf "%3d  %3d  %-${gNameLength}s %4.1f",
      $rank, $p->{'seed'}, $p->{'fname'}, $p->{'wins'};
    printf " %+5d", $p->{'spread'} unless $opt_S;
    if ($p->{'oldr'}) {
      printf " %4d %4d %+4d ", $p->{'oldr'}, $p->{'newr'}, $p->{'newr'}-$p->{'o
ldr'};
      }
    else { printf " n.r. %4d      ", $p->{'newr'}; }
    printf "%3d %3d %3d", $p->{'afor'}+0.5, $p->{'aagn'}+0.5, $p->{'hi'}
      unless $opt_S;
    print "\n";
    $p->{'rank'} = $i++;
    }
  print "\n";

  $rank = 1;
  for $p ($opt_f ? @$ps : @ranked) {
    printf "%${gNumberLength}d  %-${gNameLength}s ", $rank++, $p->{'fname'};
    for $round (0..$#{$p->{'opps'}}) {
      $o = $p->{'opps'}[$round];
      if ($o == -1) { printf "B%s ", ('-' x $gNumberLength); }
      elsif ($round > $#{$p->{'scores'}}) {
        printf "?%0${gNumberLength}d ",
          $ps->[$o]{$opt_f ? 'id' : 'rank'} + $opt_f;
        }
      else {
        printf "%s%0${gNumberLength}d ",
          ('L','T','W')[($p->{'scores'}[$round]<=>$ps->[$o]{'scores'}[$round])+
1],
          $ps->[$o]{$opt_f ? 'id' : 'rank'} + $opt_f;
        }
      }
    print "\n";
    unless ($opt_S) {
      printf "%${gNumberLength}s  %-${gNameLength}s ", '', '';
      for $round (0..$#{$p->{'scores'}}) {
        $o = $p->{'opps'}[$round];
        if ($o == -1) { printf "%${gNumberLength}s  ", ''; }
        else {
          printf "%s%3d ", (' ' x ($gNumberLength-2)), $p->{'scores'}[$round];
          }
        }
      print "\n";
      }
    }
  }

# &WriteSS($players, $player_number)
sub WriteSS { local($ps, $pn) = @_;
  local($diff, $l, $o, $os, $osc, $p, $psc, $result, $round, $spread, $w);
  if (--$pn >= 0 && $pn <= $#$ps) {
    printf "Scoresheet for player %d: %s\n", 1+$pn, $ps->[$pn]{'fname'};
    $p = $ps->[$pn];
    $os = $p->{'opps'};
    $l = $spread = $w = 0;
    for $round (0..$#$os) {
      last if $round > $#{$p->{'scores'}};
      $o = $os->[$round];
      if ($o == -1) { # bye
        $spread += $psc = $p->{'scores'}[$round];
        $result = (($psc <=> 0) + 1) / 2;
        $w += $result; $l += 1 - $result;
        printf "%${gNumberLength}d. %-${gNameLength}s %4s %4.1f %4.1f  %3s %3s"
          ." %+4d %+5d\n",
          $round+1, 'bye', '', $w, $l, '', '', $psc, $spread;
        }
      else {
        $o = $ps->[$o];
        $osc = $o->{'scores'}[$round];
        $psc = $p->{'scores'}[$round];
        $spread += $diff = $psc - $osc;
        $result = (($diff <=> 0) + 1) / 2;
        $w += $result; $l += 1 - $result;
        printf "%${gNumberLength}d. %-${gNameLength}s %4d %4.1f %4.1f  %3d %3d"
          ." %+4d %+5d\n",
          $round+1, $o->{'fname'}, $o->{'oldr'}, $w, $l, $psc, $osc, $diff, $sp
read;
        }
      }
    }
  else {
    printf STDERR "Player number %d is outside of the range 1..%d.\n",
      ++$pn, $#$ps+1;
    }
  }