#!/usr/bin/perl

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

package TSH::Command::PRiZes;

use strict;
use warnings;

use TSH::Division::FindExtremeGames;
use TSH::Log;
use TSH::Utility qw(Debug DebugOn Ordinal);

# DebugOn('SP');

our (@ISA) = qw(TSH::Command);

=pod

=head1 NAME

TSH::Command::PRiZes - implement the C<tsh> PRiZes command

=head1 SYNOPSIS

  my $command = new TSH::Command::PRiZes;
  my $argsp = $command->ArgumentTypes();
  my $helptext = $command->Help();
  my (@names) = $command->Names();
  $command->Run($tournament, @parsed_arguments);
  
=head1 ABSTRACT

TSH::Command::PRiZes is a subclass of TSH::Command.

=cut

=head1 DESCRIPTION

=over 4

=cut

my (@column_classes) = qw(number description value winner);
my %school_bios;

sub DivisionName ($$);
sub initialise ($$$$);
sub LongTaggedName ($);
sub new ($);
sub Run ($$@);
sub ShowPrize ($$$$);

=item $string = DivisionName($tournament, $dname);

Return "Division $dname " if the tournament has more than
one division, else the empty string.

=cut

sub DivisionName ($$) {
  my $tourney = shift;
  my $dname = shift;
  if ($tourney->CountDivisions() > 1) {
    return "Division $dname ";
    }
  else {
    return '';
    }
  }

sub FindPlayers ($$$$) {
  my $this = shift;
  my $tournament = shift;
  my $dp = shift;
  my $prize = shift;
  my (@players);
  if ($prize->{'memberfile'}) {
    (@players) = $this->LoadPlayersFromFile($tournament, $dp, $prize);
    }
  elsif ($prize->{'members'}) {
    if ($dp) {
      (@players) = grep { defined $_ } 
	map { $dp->Player($_) } @{eval $prize->{'members'}};
      }
    else {
      (@players) = $this->LoadPlayersFromList($tournament, $prize);
      }
    }
  elsif ($dp) {
    @players = $dp->Players();
    }
  else {
    for my $dp1 ($tournament->Divisions()) {
      push(@players, $dp1->Players());
      }
    }
  if (my $class = $prize->{'class'}) {
    my $had_members = scalar(@players);
    @players = grep { ($_->Class()||'noclass') eq $class} @players;
    if ($had_members and !@players) {
      $tournament->TellUser('eclassemp', $dp->Name(), $class);
      }
    }
#     die "@$members" if ref($prize->{'members'}) eq 'ARRAY';
  return @players;
  }

=item $parserp->initialise()

Used internally to (re)initialise the object.

=cut

sub initialise ($$$$) {
  my $this = shift;
  my $path = shift;
  my $namesp = shift;
  my $argtypesp = shift;

  $this->{'help'} = <<'EOF';
Use this command to display a prize table.
"PRiZe" lists all prizes and winners as they would be
awarded based on current data.
"PRiZe chart" will list only the prizes to be awarded,
not the winners.
EOF
  $this->{'names'} = [qw(prz prizes)];
  $this->{'argtypes'} = [qw(Text)];
# print "names=@$namesp argtypes=@$argtypesp\n";

  return $this;
  }

sub LoadPlayersFromFile ($$$$) {
  my $this = shift;
  my $tournament = shift;
  my $dp = shift;
  my $prize = shift;
  my (@players);
  my $config = $tournament->Config();
  my $fn = $config->MakeRootPath($prize->{'memberfile'});
  my $fh = TSH::Utility::OpenFile("<", $fn);
  while (<$fh>) {
    chomp; s/^\s+//; s/\s+$//;
    my $p = $tournament->FindPlayer($_, undef, $dp);
    if (defined $p) {
      push(@players, $p);
      }
    else {
      warn "PRiZES: no such player: $_\n";
      }
    }
  return @players;
  }

sub LoadPlayersFromList ($$$) {
  my $this = shift;
  my $tournament = shift;
  my $prize = shift;
  my (@players);
  for my $member (@{$prize->{'members'}}) {
    if ($member =~ /^([a-zA-Z]+)(\d+)$/) {
      my $dn = $1;
      my $pn = $2;
      my $dp = $tournament->GetDivisionByName($dn);
      if (!$dp) {
	warn "'$dn' is not a valid division name in player '$member'.\n";
	}
      else {
	if (my $p = $dp->Player($pn)) {
	  push(@players, $p);
	  }
	else {
	  warn "'$member' is not a valid player number.\n";
	  }
	}
      }
    else {
      warn "PRiZes: Can't find division name and player number in: $member\n";
      }
    }
  return @players;
  }

sub LongTaggedName ($) {
  my $p = shift;
  my $config = $p->Division()->Tournament()->Config();
  my $name = $p->TaggedName();
  if (my $sbpath = $config->Value('school_bios')) {
    unless (%school_bios) {
      eval 'use NSA::SchoolBios qw(LoadBios)';
      die $@ if $@;
      my $psp = NSA::SchoolBios::LoadBios($config->MakeRootPath($sbpath));
      for my $p1 (@$psp) {
	my $sname = $p1->{'school'};
#	$sname =~ s/#//;
	$school_bios{$sname} = $p1;
	}
      }
    my $sname = $p->Name();
    if (my $sp = $school_bios{$sname}) {
      $name .= " $sp->{'player1'}, $sp->{'player2'} ($sp->{'city'}, $sp->{'state'})";
      }
    else {
      warn "No such school in $sbpath: $sname";
     }
    }
  return $name;
  }

sub new ($) { return TSH::Utility::new(@_); }

=item $command->Run($tournament, @parsed_args)

Should run the command in the context of the given
tournament with the specified parsed arguments.

=cut

# TODO: split this up into smaller subs for maintainability

sub Run ($$@) { 
  my $this = shift;
  my $tournament = shift;
  my $config = $tournament->Config();
  my $chart = shift;

  my $nowinner = $this->{'prz_nowinner'} = ($chart || '') =~ /^chart$/i;
  my $partial = 0;

  if (!defined $config->Value('max_rounds')) {
    $tournament->TellUser('eneed_max_rounds');
    return;
    }

  my $logp = new TSH::Log($tournament, undef, 'prizes', undef);
  my (@text_titles) = ('#', 'Prize');
  my (@html_titles) = ('#', qw(Description Value));
  unless ($nowinner) {
    $text_titles[-1] .= ', Winner';
    push(@html_titles, 'Winner(s)');
    for my $dp ($tournament->Divisions()) {
      unless ($dp->IsComplete()) {
	$partial = 1;
	}
      }
    $logp->WritePartialWarning(4) if $partial;
    }
  $logp->ColumnClasses(\@column_classes, 'top1');
  $logp->ColumnTitles({'text' => \@text_titles, 'html' => \@html_titles});
  my $break = $config->Value('prizes_page_break') || 1000;
  my $prizeno = 1;
  $this->{'xclude'} = {};
  for my $p0 (0..$#config::prizes) {
    if ($p0 && $p0 % $break == 0) {
      $logp->PageBreak();
      $logp->ColumnTitles({'text' => [], 'html' => \@html_titles});
      }
    my $prize = $config::prizes[$p0];
    $this->ShowPrize($tournament, $logp, $prizeno, $prize);
    $prizeno++ unless $prize->{'type'} =~ /^(?:separator|note)$/;
    }
  $logp->Close();
  return 0;
  }

my %gPrizeData;
BEGIN {
  # when 'unit' == 'game',
  #   games are represented as lists: [$score1, $score2, $p1, $p2, $r0, $rat1, $rat2].
  # when 'unit' == 'player', the objects passed to subs are of class TSH::Player
  %gPrizeData = (
    'brlh' => { # best record lower half, as per US NSC
      'initialise' => sub { 
	my $prize = shift;
	my $tournament = shift;
	my $config = $tournament->Config();
	my $dp = $tournament->GetDivisionByName($prize->{'division'});
	my $firstr0 = $prize->{'first'} - 1;
	$dp->ComputeRanks($prize->{'first'}-2);
	my (@players) = 
	  # must have played at least one game today
	  grep { $_->CountScores() > $firstr0 }
	  $dp->Players();
	if ($config->Value('standings_spread_cap')) {
	  @players = TSH::Player::SortByCappedStanding($firstr0-1, @players);
	  }
	else {
	  @players = TSH::Player::SortByStanding($firstr0-1, @players);
	  }
        for my $i (0..@players/2-1) 
	  { $players[$i]->{'xr'} = 0; }
	for my $i (@players/2 .. $#players) {
	  { $players[$i]->{'xr'} = $i+1; }
	  }
        },
      'unit' => 'player',
      'filter' => sub ($$) { 
	my $p = shift;
	my $prize = shift;
	my $firstr0 = $prize->{'first'} - 1;
	my $lastr0 = $prize->{'last'} - 1;
	# must have played at least one game today
	return 0 unless $p->CountScores() > $firstr0; 
	return 0 unless $p->{'xr'};
	$p->{'xw'} = $p->RoundWins($lastr0)-$p->RoundWins($firstr0-1);
	$p->{'xl'} = $p->RoundLosses($lastr0)-$p->RoundLosses($firstr0-1);
	$p->{'xs'} = $p->RoundSpread($lastr0)-$p->RoundSpread($firstr0-1);
	return 1;
	},
      'compare' => sub ($$) { 
	$_[1]->{'xw'} <=> $_[0]->{'xw'}
	|| $_[0]->{'xl'} <=> $_[1]->{'xl'}
	|| $_[1]->{'xs'} <=> $_[0]->{'xs'}
	},
      'prizename' => sub {
	my $prize = shift;
	my $tourney = shift;
	return DivisionName($tourney, $prize->{'division'}) . "$prize->{'division'} Best Record Lower Half Rounds $prize->{'first'}-$prize->{'last'}";
        },
      'formatwinner' => sub {
	my $p = shift @_;
	return sprintf("%s %.1f-%.1f %+d starting %s", LongTaggedName($p), 
	  $p->{'xw'}, $p->{'xl'}, $p->{'xs'},
	  Ordinal($p->{'xr'}));
        },
      'rankcriterion' => sub ($) { my $p = shift @_; return 
	join(';', @$p{qw(xw xl xs)}) 
        },
      },
    'highloss' => {
      'unit' => 'player',
      'filter' => sub ($$) { 
	my $p = shift;
	$p->{'xhl'} = -9999;
	$p->{'xr0'} = undef;
	for my $r0 (0..$p->CountScores()-1) {
	  my $ms = $p->Score($r0);
	  my $os = $p->OpponentScore($r0);
	  next unless (defined $ms) && (defined $os) && $ms < $os;
	  if ($p->{'xhl'} < $ms) {
	    $p->{'xhl'} = $ms;
	    $p->{'xr0'} = $r0;
	    }
	  }
	return defined $p->{'xr0'};
	},
      'compare' => sub ($$) { $_[1]->{'xhl'} <=> $_[0]->{'xhl'} },
      'prizename' => 'High Loss',
      'formatwinner' => sub {
	my $p = shift @_;
	my $r0 = $p->{'xr0'};
	return sprintf("%s %d-%d vs. %s", LongTaggedName($p), $p->{'xhl'}, 
	  $p->OpponentScore($r0), LongTaggedName($p->Opponent($r0)));
        },
      'rankcriterion' => sub ($) { my $p = shift @_; return $p->{'xhl'}; },
      },
    'highratingchange' => {
      'initialise' => sub { 
	my $prize = shift;
	my $tournament = shift;
	my $dp = $tournament->GetDivisionByName($prize->{'division'}) 
	  or $tournament->TellUser('ebaddiv', $prize->{'division'});
	&::Use('TSH::ReportCommand::ExtremePlayers');
	my $r0 = $dp->MostScores() - 1;
	$dp->ComputeRatings($r0);
        },
      'unit' => 'player',
      'filter' => sub ($$) {
	my $p = shift;
	my $prize = shift;
	return 0 unless TSH::ReportCommand::ExtremePlayers::SelectActiveRatedPlayers($p);
	$p->{'xhrc'} = $p->NewRating(-1) - $p->Rating();
        },
      'compare' => sub ($$) { $_[1]->{'xhrc'} <=> $_[0]->{'xhrc'} },
      'prizename' => 'High Rating Change',
      'formatwinner' => sub {
	my $p = shift;
	my $prize = shift;
	return sprintf("%s %+d = %d-%d", LongTaggedName($p), $p->{'xhrc'}, 
	  $p->NewRating(-1), $p->Rating());
        },
      'rankcriterion' => sub ($) { my $p = shift @_; return $p->{'xhrc'}; },
      },
    'highroundloss' => {
      'unit' => 'player',
      'filter' => sub ($$) { 
	my $p = shift;
	my $prize = shift;
	my $r1 = $prize->{'round'};
	my $r0 = $r1 - 1;
	my $ms = $p->Score($r0);
	return 0 unless defined $ms;
	my $os = $p->OpponentScore($r0);
	return 0 unless defined $os;
	$p->{'xhrl'} = $ms;
	return $ms < $os;
	},
      'compare' => sub ($$) { $_[1]->{'xhrl'} <=> $_[0]->{'xhrl'} },
      'prizename' => sub {
	my $prize = shift;
	my $tourney = shift;
	return DivisionName($tourney, $prize->{'division'}) .  "High Loss Round $prize->{'round'}";
        },
      'formatwinner' => sub {
	my $p = shift;
	my $prize = shift;
	my $r1 = $prize->{'round'};
	my $r0 = $r1 - 1;
	return sprintf("%s %d-%d vs. %s", LongTaggedName($p), $p->{'xhrl'}, 
	  $p->OpponentScore($r0), LongTaggedName($p->Opponent($r0)));
        },
      'rankcriterion' => sub ($) { my $p = shift @_; return $p->{'xhrl'}; },
      },
    'highroundwin' => {
      'unit' => 'player',
      'filter' => sub ($$) { 
	my $p = shift;
	my $prize = shift;
	my $r1 = $prize->{'round'};
	my $r0 = $r1 - 1;
	my $ms = $p->Score($r0);
	return 0 unless defined $ms;
	my $os = $p->OpponentScore($r0);
	return 0 unless defined $os;
	$p->{'xhrw'} = $ms;
	return $ms > $os;
	},
      'compare' => sub ($$) { $_[1]->{'xhrw'} <=> $_[0]->{'xhrw'} },
      'prizename' => sub {
	my $prize = shift;
	my $tourney = shift;
	return DivisionName($tourney, $prize->{'division'}) .  "High Win Round $prize->{'round'}";
        },
      'formatwinner' => sub {
	my $p = shift;
	my $prize = shift;
	my $r1 = $prize->{'round'};
	my $r0 = $r1 - 1;
	return sprintf("%s %d-%d vs. %s", LongTaggedName($p), $p->{'xhrw'}, 
	  $p->OpponentScore($r0), LongTaggedName($p->Opponent($r0)));
        },
      'rankcriterion' => sub ($) { my $p = shift @_; return $p->{'xhrw'}; },
      },
    'highwin' => {
      'unit' => 'player',
      'filter' => sub ($$) { 
	my $p = shift;
	$p->{'xhw'} = -9999;
	$p->{'xr0'} = undef;
	for my $r0 (0..$p->CountScores()-1) {
	  my $ms = $p->Score($r0);
	  my $os = $p->OpponentScore($r0);
	  next unless (defined $ms) && (defined $os) && $ms > $os;
	  if ($p->{'xhw'} < $ms) {
	    $p->{'xhw'} = $ms;
	    $p->{'xr0'} = $r0;
	    }
	  }
	return defined $p->{'xr0'};
	},
      'compare' => sub ($$) { $_[1]->{'xhw'} <=> $_[0]->{'xhw'} },
      'prizename' => 'High Win',
      'formatwinner' => sub {
	my $p = shift @_;
	my $r0 = $p->{'xr0'};
	return sprintf("%s %d-%d vs. %s", LongTaggedName($p), $p->{'xhw'}, 
	  $p->OpponentScore($r0), LongTaggedName($p->Opponent($r0)));
        },
      'rankcriterion' => sub ($) { my $p = shift @_; return $p->{'xhw'}; },
      },
    'lowwin' => {
      'unit' => 'player',
      'filter' => sub ($$) { 
	my $p = shift;
	$p->{'xlw'} = 9999;
	$p->{'xr0'} = undef;
	for my $r0 (0..$p->CountScores()-1) {
	  my $ms = $p->Score($r0);
	  my $os = $p->OpponentScore($r0);
	  next unless (defined $ms) && (defined $os) && $ms > $os;
	  if ($p->{'xlw'} > $ms) {
	    $p->{'xlw'} = $ms;
	    $p->{'xr0'} = $r0;
	    }
	  }
	return defined $p->{'xr0'};
	},
      'compare' => sub ($$) { $_[0]->{'xlw'} <=> $_[1]->{'xlw'} },
      'prizename' => 'Low Win',
      'formatwinner' => sub {
	my $p = shift @_;
	my $r0 = $p->{'xr0'};
	return sprintf("%s %d-%d vs. %s", LongTaggedName($p), $p->{'xlw'}, 
	  $p->OpponentScore($r0), LongTaggedName($p->Opponent($r0)));
        },
      'rankcriterion' => sub ($) { my $p = shift @_; return $p->{'xlw'}; },
      },
    'luckystiff' => {
      'initialise' => sub { 
	my $prize = shift;
	my $tournament = shift;
	eval "use TSH::Player::LuckyStiff";
	if ($@) {
	  $tournament->TellUser('enomod', 'TSH/Player/LuckyStiff.pm', $@);
	  }
        },
      'unit' => 'player',
      'filter' => sub ($$) { 
	my $pp = shift;
	my ($tl, $lossesp) = $pp->LuckyStiff(6);
	$pp->{'xls'} = $tl or return 0;
	$pp->{'xlss'} = $lossesp;
	return 1;
	},
      # big ratings differences first
      'compare' => sub ($$) { $_[0]{'xls'} <=> $_[1]{'xls'} },
      'prizename' => 'Lucky Stiff',
      'formatwinner' => sub {
	my $p = shift @_;
	return sprintf("%s %d = %s",
	  LongTaggedName($p),
	  $p->{'xls'},
	  join('+', @{$p->{'xlss'}}),
	  );
        },
      'rankcriterion' => sub ($) { my $p = shift @_; return $p->{'xls'}; }
      },
    'overexp' => {
      'initialise' => sub { 
	my $prize = shift;
	my $tournament = shift;
	my $dp = $tournament->GetDivisionByName($prize->{'division'}) 
	  or $tournament->TellUser('ebaddiv', $prize->{'division'});
	my $r0 = $dp->MostScores() - 1;
	$dp->ComputeRatings($r0);
        },
      'unit' => 'player',
      'filter' => sub ($$) { 
	my $p = shift @_;
	return 0 unless $p->CountScores(); 
	return 0 unless $p->Active();
	return 0 unless TSH::ReportCommand::ExtremePlayers::SelectActiveRatedPlayers($p);
	$p->{'xoe'} = die "not yet";
#	warn $p->Name();
	1;
        },
      'compare' => sub ($$) { 
	$_[1]->{'xoe'} <=> $_[0]->{'xoe'};
        },
      'prizename' => 'OverExpectation',
      'formatwinner' => sub {
	my $p = shift @_;
	my $wins = $p->Wins();
	return sprintf("%s %g-%g %+d (expected %.2f excess %.2f)", 
	  LongTaggedName($p), $wins, $p->Losses(), $p->Spread(), 
	  $wins - $p->{'xoe'}, 
	  $p->{'xoe'}, 
	  );
        },
      'rankcriterion' => sub ($) { 
	my $p = shift @_;
	return join(';', $p->{'xoe'});
        },
      },
    'overseed' => {
      'initialise' => sub { 
	my $prize = shift;
	my $tournament = shift;
	my $dp = $tournament->GetDivisionByName($prize->{'division'}) 
	  or $tournament->TellUser('ebaddiv', $prize->{'division'});
	my $lastr0 = $dp->MaxRound0();
	$dp->ComputeRanks($lastr0);
	my (@players) = TSH::Player::SortByInitialStanding($dp->Players());
	my $lastrat = -1;
	my $rank = 0;
	# TODO: should use Utility::*Rank*
	for my $i (0..$#players) {
	  my $p = $players[$i];
	  my $rat = $p->Rating();
	  if ($rat != $lastrat) {
	    $rank = $i + 1;
	    $lastrat = $rat;
	    }
	  $p->{'xseed'} = $rank;
	  }
        },
      'unit' => 'player',
      'filter' => sub ($$) { 
	my $p = shift @_;
#	warn $p->Name();
	return 0 unless $p->CountScores() || $p->Division()->Tournament()->Config->Value('scores') eq 'sudoku'; 
	return 0 unless $p->Active();
#	warn $p->Name();
	1;
        },
      # TODO: duplicated in TSH::Player::SortByCurrentStanding
      'compare' => sub ($$) { 
	$_[0]->RoundRank(-2) - $_[0]->{'xseed'} 
	  <=> $_[1]->RoundRank(-2) - $_[1]->{'xseed'} ||
	$_[0]->RoundRank(-2) <=> $_[1]->RoundRank(-2)
        },
      'prizename' => 'OverSeed',
      'formatwinner' => sub {
	my $p = shift @_;
	return sprintf("%s %g-%g %+d (seed %d overall rank %d)", LongTaggedName($p), $p->Wins(),
	  $p->Losses(), $p->Spread(), $p->{'xseed'}, $p->RoundRank(-2));
        },
      'rankcriterion' => sub ($) { 
	my $p = shift @_;
	return join(';', $p->RoundRank(-2) - $p->{'xseed'}, $p->RoundRank(-2));
        },
      },
    'rank' => {
      'unit' => 'player',
      'filter' => sub ($$) { 
#	$_[0]->Active();
	return 0 unless $_[0]->GamesPlayed() || ($_[0]->Division()->Tournament()->Config->Value('scores')||'') eq 'sudoku'; 
	1;
        },
      # TODO: duplicated in TSH::Player::SortByCurrentStanding
      'compare' => sub ($$) { 
	my $is_capped = $_[0]->Division()->Tournament()->Config()->Value('standings_spread_cap');
	$_[1]->Wins() <=> $_[0]->Wins()
	|| $_[0]->Losses() <=> $_[1]->Losses()
	|| (
	  $is_capped
	    ? ($_[1]->CappedSpread() <=> $_[0]->CappedSpread())
	    : ($_[1]->Spread() <=> $_[0]->Spread())
	  )
	|| $_[1]->Rating() <=> $_[0]->Rating()
	|| $_[1]->Random() <=> $_[0]->Random()
        },
      'prizename' => 'Rank',
      'formatwinner' => sub {
	my $p = shift @_;
	my $is_capped = $p->Division()->Tournament()->Config()->Value('standings_spread_cap');
	return sprintf("%s %g-%g %+d", LongTaggedName($p), $p->Wins(),
	  $p->Losses(), $is_capped ? $p->CappedSpread() : $p->Spread());
        },
      'rankcriterion' => sub ($) { 
	my $p = shift @_;
	return join(';', $p->Wins(), $p->Losses(), $p->Spread()); 
        },
      },
    'roundrecord' => {
      'unit' => 'player',
      'filter' => sub ($$) { 
	my $p = shift;
	$p->Division()->Tournament()->Config()->Value('standings_spread_cap') && die "not yet";
	my $prize = shift;
	my $firstr0 = $prize->{'first'} - 1;
	my $lastr0 = $prize->{'last'} - 1;
	return 0 unless $p->CountScores() > $firstr0; # must have played at least one game in range
	$p->{'xw'} = $p->RoundWins($lastr0)-$p->RoundWins($firstr0-1);
	$p->{'xl'} = $p->RoundLosses($lastr0)-$p->RoundLosses($firstr0-1);
	$p->{'xs'} = $p->RoundSpread($lastr0)-$p->RoundSpread($firstr0-1);
	return 1;
	},
      'compare' => sub ($$) { 
	$_[1]->{'xw'} <=> $_[0]->{'xw'}
	|| $_[0]->{'xl'} <=> $_[1]->{'xl'}
	|| $_[1]->{'xs'} <=> $_[0]->{'xs'}
	},
      'prizename' => sub {
	my $prize = shift;
	my $tourney = shift;
	return DivisionName($tourney, $prize->{'division'}) 
	  . "Best Record Rounds $prize->{'first'}-$prize->{'last'}";
        },
      'formatwinner' => sub {
	my $p = shift @_;
	return sprintf("%s %.1f-%.1f %+d", LongTaggedName($p), 
	  $p->{'xw'}, $p->{'xl'}, $p->{'xs'},
	);
        },
      'rankcriterion' => sub ($) { my $p = shift @_; return 
	join(';', @$p{qw(xw xl xs)}) 
        },
      },
    'tuffluck' => {
      'initialise' => sub { 
	my $prize = shift;
	my $tournament = shift;
	eval "use TSH::Player::TuffLuck";
	if ($@) {
	  $tournament->TellUser('enomod', 'TSH/Player/TuffLuck.pm', $@);
	  }
        },
      'unit' => 'player',
      'filter' => sub ($$) { 
	my $pp = shift;
	my ($tl, $lossesp) = $pp->TuffLuck(6);
	$pp->{'xtl'} = $tl or return 0;
	$pp->{'xtls'} = $lossesp;
	return 1;
	},
      # big ratings differences first
      'compare' => sub ($$) { $_[0]{'xtl'} <=> $_[1]{'xtl'} },
      'prizename' => 'Tuff Luck',
      'formatwinner' => sub {
	my $p = shift @_;
	return sprintf("%s %d = %s",
	  LongTaggedName($p),
	  $p->{'xtl'},
	  join('+', @{$p->{'xtls'}}),
	  );
        },
      'rankcriterion' => sub ($) { my $p = shift @_; return $p->{'xtl'}; }
      },
    'totalteam' => {
      'unit' => 'totalteam',
      'initialise' => sub {
	my $prize = shift;
	$prize->{'prizename'} = 'Average Team Record';
        },
      'filter' => sub ($$) { 
	my $teamp = shift;
	my $prize = shift;
	my $w = 0;
	my $l = 0;
	my $s = 0;
	my $n = 0;
	for my $p (@{$teamp->{'members'}}) {
	  $w += $p->Wins();
	  $l += $p->Losses();
	  $s += $p->Spread();
	  $n ++;
	  }
	$teamp->{'wins'} = $w;
	$teamp->{'losses'} = $l;
	$teamp->{'spread'} = $s;
	$teamp->{'count'} = $n;
	return 0 unless $n;
	return 1;
	},
      # big ratings differences first
      'compare' => sub ($$) {
	$_[1]->{'wins'}/$_[1]->{'count'}
	  <=> $_[0]->{'wins'}/$_[0]->{'count'}
	|| $_[0]->{'losses'}/$_[0]->{'count'}
	  <=> $_[1]->{'losses'}/$_[1]->{'count'}
	|| $_[1]->{'spread'}/$_[1]->{'count'}
	  <=> $_[0]->{'spread'}/$_[0]->{'count'}
        },
      'prizename' => 'Average Team Record',
      'formatwinner' => sub {
	my $e = shift @_;
	return sprintf("%s %.2f-%.2f %+.1f",
 	  $e->{'name'},
	  $e->{'wins'}/$e->{'count'},
	  $e->{'losses'}/$e->{'count'},
	  $e->{'spread'}/$e->{'count'},
	  );
        },
      'rankcriterion' => sub ($) { my $e = shift @_; 
	return join(';',
	  $e->{'wins'}/$e->{'count'},
	  $e->{'losses'}/$e->{'count'},
	  $e->{'spread'}/$e->{'count'},
	  ); },
      },
    'upset' => {
      'unit' => 'game',
      'filter' => sub ($$) { 
	(defined $_[0][0]) # player one has a score
	&& (defined $_[0][1]) # player two has a score
	&& $_[0][0] > $_[0][1] # player one won
	&& $_[0][5] # player one is rated
	&& $_[0][5] < $_[0][6] # player one is rated lower than player two
	},
      # big ratings differences first
      'compare' => sub ($$) { $_[1][6]-$_[1][5] <=> $_[0][6]-$_[0][5] },
      'prizename' => 'Ratings Upset Win',
      'formatwinner' => sub {
	my $e = shift @_;
	return sprintf("%s %d-%d=%d, %d-%d vs. %s", 
 	  LongTaggedName($e->[2]), 
 	  $e->[6], # opp rating
 	  $e->[5], # player rating
 	  $e->[6]-$e->[5], # rating difference
 	  $e->[0], # player score
 	  $e->[1], # opp score
 	  LongTaggedName($e->[3]), # opp name
	  );
        },
      'rankcriterion' => sub ($) { my $e = shift @_; return $e->[6]-$e->[5]; },
      },
    );
  }

=item $this->ShowPrize($tournament, $logp, $prizeno, $prize);

Add the data for the given prize to the log.

=cut

sub ShowPrize ($$$$) {
  my $this = shift;
  my $tournament = shift;
  my $logp = shift;
  my $prizeno = shift;
  my $prize = shift;
  my $type = $prize->{'type'} || '';
  my $config = $tournament->Config();
  my $show_honourable_mention = $config->Value('show_honourable_mention');
# warn "1. type: $type";
  if (my $prize_data = $gPrizeData{$type}) {
    my $dname = $prize->{'division'} || '';
    my $dp;
    if ($dname ne '*') {
      $dp = $tournament->GetDivisionByName($dname) or do {
	$tournament->TellUser('ebaddiv', $dname);
	return;
	};
      }
    # subtype: typically the rank within the category being awarded
    my $subtype = $prize->{'subtype'} || 1;
    my $value = $prize->{'value'} || '?';
    my $groupname = (defined $prize->{'groupname'}) ?  "$prize->{'groupname'} " : '';
    my $initialiser = $prize_data->{'initialise'};
    if (ref($initialiser) eq 'CODE') { &$initialiser($prize, $tournament); }
    my $entriesp;
    my $unit = $prize_data->{'unit'};
    if ($unit eq 'game') {
      my $count = $subtype < 0 ? 1E12 : $subtype + 20; # just to be safe
      $entriesp = TSH::Division::FindExtremeGames::Search(
	$dp, $count, \&{$prize_data->{'filter'}}, \&{$prize_data->{'compare'}})
      }
    elsif ($unit eq 'player') {
      my $compare = $prize_data->{'compare'};
      my $filter = $prize_data->{'filter'};
      my (@players) = $this->FindPlayers($tournament, $dp, $prize);
      $entriesp = [sort $compare grep { &$filter($_, $prize) } @players];
      }
    elsif ($unit eq 'totalteam') {
      my %teams;
      for my $dp ($tournament->Divisions()) {
	for my $p ($dp->Players()) {
	  if (my $team = $p->Team()) {
	    $teams{$team}{'name'} = $team;
	    push(@{$teams{$team}{'members'}}, $p);
	    }
	  }
        }
      my $compare = $prize_data->{'compare'};
      my (@teams) = keys %teams;
#     die "@$members" if ref($prize->{'members'}) eq 'ARRAY';
      $entriesp = 
        [sort $compare
        grep { &{$prize_data->{'filter'}}($_, $prize) } 
	values %teams];
      }
    my $lastv = undef;
    my $rank = 0;
    my $rankcriterion = $prize_data->{'rankcriterion'};
    my $prize_name = $prize_data->{'prizename'};
    if ($prize->{'prizename'}) 
      { $prize_name = $prize->{'prizename'}; }
    elsif (ref($prize_name) eq 'CODE') 
      { $prize_name = &$prize_name($prize, $tournament); }
    else { 
      $prize_name = DivisionName($tournament, $dname)
        . "${groupname}$prize_name"; 
      }
    if ($subtype != 1 || $prize_data->{'prizename'} =~ /^(?:Rank|Average Team Record)$/) {
      $prize_name .= ": ";
      $prize_name .= Ordinal(abs($subtype));
      $prize_name .= ' (from bottom)' if $subtype < 0;
      }

    my $delta;
    my $start;
    my $end;
    if ($subtype >= 0) {
      $delta = 1;
      $start = 0;
      $end = $#$entriesp+1;
      }
    else {
      $delta = -1;
      $start = -1;
      $end = -@$entriesp-1;
      }
#   warn "$prize_data->{'prizename'} entries=@{[$#$entriesp+1]} $subtype $delta $start $end";
    if ($this->{'prz_nowinner'} ||$prize->{'winner'}) {
      $this->WritePrizeRow($logp, $prizeno, $prize_name, $value, $prize->{'winner'});
      }
    elsif (@$entriesp) {
      my @winners;
      while (1) {
	my $someone_excluded = 0;
	for (my $i = $start; $i != $end; $i += $delta) {
	  my $changed = 0;
	  my $e = $entriesp->[$i];
	  my $v = &$rankcriterion($e);
  #       warn scalar(@$entriesp)." $prize_data->{'prizename'} $subtype $i $v $e->{'name'}";
	  if ((!defined $lastv) || $v ne $lastv) { 
	    $rank = $i < 0 ? $i : $i + 1; $lastv = $v; $changed++; 
	    }
	  if ($rank == $subtype) {
	    if (my $exclude = $prize->{'exclusive'}) {
	      # TODO: make this work with entry types other than player, that don't have FullID
	      if ($unit eq 'player' && $this->{'xclude'}{$exclude}{$e->FullID()}) {
		if ($show_honourable_mention) {
		  my $pname = &{$prize_data->{'formatwinner'}}($e, $prize);
		  $logp->WriteRow(
		    [$prizeno, "$prize_name; Hon. Mention: $pname"],
		    [$prizeno, $prize_name, 'Hon. Mention', $pname]
		    );
		  }
# 		warn "Skipping for $prize_data->{'prizename'}: ".$e->FullID();
		$someone_excluded = 1;
		next;
		}
	      }
	    push(@winners, $i);
	    }
	  elsif ($delta * ($rank-$subtype) > 0) { last; }
	  }
	last if @winners;
	last unless $someone_excluded;
	$subtype += $delta;
	}
      if (@winners == 0) {
	$logp->WriteRow(
	  [$prizeno, "$prize_name; Value: $value; Winner: "],
	  [$prizeno, $prize_name, $value, '&nbsp;']
	  );
        }
      elsif (@winners == 1) {
	my $winner = $entriesp->[$winners[0]];
        my $pname = &{$prize_data->{'formatwinner'}}($winner, $prize);
	if (my $exclude = $prize->{'exclusive'}) {
	  $this->{'xclude'}{$exclude}{$winner->FullID()}++;
	  }
	$logp->WriteRow(
	  [$prizeno, "$prize_name; Value: $value; Winner: $pname"],
	  [$prizeno, $prize_name, $value, $pname]
	  );
        }
      else {
	my $nwinners = scalar(@winners);
	$logp->ColumnAttributes([("rowspan=$nwinners") x 3]);
	for my $i (0..$#winners) {
	  if ($i == 1) {
	    $logp->ColumnAttributes([]);
	    $logp->ColumnClasses([qw(winner)]);
	    }
	  my $winner = $entriesp->[$winners[$i]];
	  my $pname = &{$prize_data->{'formatwinner'}}($winner, $prize);
	  $logp->WriteRow(
	    ["$prizeno (tie)", "$prize_name; Value: $value (shared); Winner: $pname"],
	    $i == 0 
	      ? ["$prizeno (tie)", $prize_name, "$value (shared)", $pname]
	      : [$pname]
	    );
	  if (my $exclude = $prize->{'exclusive'}) {
	    $this->{'xclude'}{$exclude}{$winner->FullID()}++;
#	    warn "Exclusive prizes may not be awarded correctly when ties occur.\n";
	    }
	  }
	$logp->ColumnClasses(\@column_classes);
        }
      }
    else {
      $this->WritePrizeRow($logp, $prizeno, $prize_name, $value, '');
      }
    }
  elsif ($type eq 'average') { # Diane Firstman's prize
    my $dname = $prize->{'division'} || '';
    my $dp = $tournament->GetDivisionByName($dname) or do {
      $tournament->TellUser('ebaddiv', $dname);
      return;
      };
    my $lastwl = 999;
    my $lastspread = 0;
    my $subtype = $prize->{'subtype'} || 1;
    my $i = 0;
    my $value = $prize->{'value'} || '?';
    my $rank = 0;
    for my $p (sort {
      abs($a->Wins()-$a->Losses()) <=> abs($b->Wins()-$b->Losses())
      || abs($a->Spread()) <=> abs($b->Spread())
      } $dp->Players()) {
      next unless $p->Active();
      my $changed = 0;
      $i++;
      my $wl = abs($p->Wins()-$p->Losses());
      my $spread = abs($p->Spread());
      if ($wl != $lastwl || $lastspread != $spread) {
	$changed++;
	$lastwl = $wl;
	$lastspread = $spread;
	$rank = $i;
#	warn "rank=$rank wl=$lastwl p=$p->{'name'}\n";
        }
      if ($rank == $subtype) {
	$prizeno = '...' unless $changed;
	my $pname = sprintf("%s %g-%g %+d", LongTaggedName($p), $p->Wins(),
	  $p->Losses(), $p->Spread());
	my $prizename = "Division $dname Most Average Rank: $subtype";
	$this->WritePrizeRow($logp, $prizeno, $prizename, $value, $pname);
        }
      }
    }
  elsif ($type eq 'signup') {
    my $subtype = $prize->{'subtype'} || '';
    my $value = $prize->{'value'} || '?';
    my $winner = $prize->{'winner'} || '?';
    $this->WritePrizeRow($logp, $prizeno, $subtype, $value, $winner);
    }
  elsif ($type eq 'separator') {
    my $width = $this->{'prz_nowinner'} ? 3 : 4;
    $logp->ColumnAttributes(["colspan=$width"]);
    $logp->WriteRow(['---'], ['&nbsp;']);
    $logp->ColumnAttributes([]);
    }
  elsif ($type eq 'note') {
    my $width = $this->{'prz_nowinner'} ? 3 : 4;
    $logp->ColumnAttributes(["colspan=$width"]);
    my $note = $prize->{'note'};
    $logp->WriteRow(['*', $note], [$note]);
    $logp->ColumnAttributes([]);
    }
  }

sub WritePrizeRow($$$$$$) {
  my $this = shift;
  my $logp = shift;
  my $prize_number = shift;
  my $prize_name = shift;
  my $prize_value = shift;
  my $prize_winner = shift;
  if ($this->{'prz_nowinner'}) {
    $logp->WriteRow([$prize_number, "$prize_name; Value: $prize_value"],
      [$prize_number, $prize_name, $prize_value]);
    }
  else {
    $logp->WriteRow([$prize_number, "$prize_name; Value: $prize_value; Winner: $prize_winner"],
      [$prize_number, $prize_name, $prize_value, $prize_winner||'&nbsp;']);
    }
  }

=back

=cut

=head1 BUGS

Not easy to configure.

More use should be made of FindExtremeGames and TSH::Utility::DoOneRank.

Should switch to using modern interface for Log.

Should be using the new Class() routine to designate prize classes.

Should allow multidivision syntax in prize data.

Should parse monetary value out of prize value, and use to automate 
class prizes.

The rest of the routines in gPrizeData should be moved to subclasses of 
TSH::ReportCommand::ExtremePlayers
or TSH::ReportCommand::ExtremeGames,
so that they can be shared with other commands.
Have tried doing this for a start with highratingchange.

=cut

1;
