standings.pl

A Perl-based statistics management system designed for academic competition tournaments. These tourn

#!/usr/bin/perl -w

# Livestat 1.2, by Jason Weill ([e-mail])
# Copyright (C) 2001-02 Jason Weill

# Livestat is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# Livestat is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Livestat; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

# Create the standings table.

# Requires the "scores" file to have been generated.

my %options;
my %teams;

# read the HTML header and footer
my $page_header = "";
my $page_footer = "";

if (not -e "common.head") {
  die "Header file not found";
}

if (not -e "common.foot") {
  die "Footer file not found";
}

open(HEADER, "< common.head") or die "Cannot open common header: $!";
foreach (<HEADER>) {
  $page_header .= $_;
}
close(HEADER) or die "Cannot close common header: $!";

open(FOOTER, "< common.foot") or die "Cannot open common footer: $!";
foreach (<FOOTER>) {
  $page_footer .= $_;
}
close(FOOTER) or die "Cannot close common footer: $!";

if (not -e "activetourney") {
  die "No tournament is active.  Use set-active to set a tournament.";
}

open ACTIVE, "activetourney" or die "Cannot open tournament file: $!";
chomp($dir = <ACTIVE>);
close ACTIVE or die "Cannot close tournament file: $!";

chdir($dir) or die "Cannot open directory $dir: $!";

open CONFIG, "global.cfg" or die "Cannot open configuration file: $!";

$_ = "";
until (/BEGIN TEAM/) {
  $_ = <CONFIG>;
  chomp;
  #s/\#.*//g;
  if (/=/ and not /^\#/) {
    ($option, $setting) = split(/=/, $_);
    $options{$option} = $setting;
  }
}

until (/END TEAM/) {
  $_ = <CONFIG>;
  chomp;
  if (/=/ and not /^\#/) {
    ($option, $setting) = split(/=/, $_);
    $teams{$option} = $setting;
  }
}

close CONFIG or die "Cannot close config file: $!";

open SCORES, "scores" or die "Cannot open scores file: $!";
my %records;
my %head2head;
my $rounds = 0;
$_ = "";

while (not eof(SCORES)) {
  chomp($_ = <SCORES>);
  if (/,/) {
    ($round, $team1, $team2, $score1, $score2) = split(/,/, $_);
    
    if (not $records{$team1}) {
      $records{$team1} = 
	{ wins => 0, losses => 0, ties => 0, pf => 0, pa => 0};
    }
    if (not $records{$team2}) {
      $records{$team2} =
	{ wins => 0, losses => 0, ties => 0, pf => 0, pa => 0};
    }
    
    if ($round > $rounds) { $rounds = $round; }

    $records{$team1}{"pf"} += $score1;
    $records{$team1}{"pa"} += $score2;
    $records{$team2}{"pf"} += $score2;
    $records{$team2}{"pa"} += $score1;

    $tag1 = $team1 . "=" . $team2;
    $tag2 = $team2 . "=" . $team1;

    @hh1 = $head2head{$tag1} || (0, 0, 0, 0, 0);
    @hh2 = $head2head{$tag2} || (0, 0, 0, 0, 0);

    $hh1[4] += $score1;
    $hh2[4] += $score2;
    $hh1[5] += $score2;
    $hh2[5] += $score1;

    if ($score1 > $score2) {
      ($records{$team1}{"wins"})++;
      ($records{$team2}{"losses"})++;
      ($hh1[0])++;
      ($hh2[1])++;
    } elsif ($score2 > $score1) {
      ($records{$team1}{"losses"})++;
      ($records{$team2}{"wins"})++;
      ($hh1[1])++;
      ($hh2[0])++;
    } else {
      ($records{$team1}{"ties"})++;
      ($records{$team2}{"ties"})++;
      ($hh1[2])++;
      ($hh2[2])++;
    }

    push(@{$head2head{$tag1}}, @hh1);
    push(@{$head2head{$tag2}}, @hh2);
  }
}

sub wlrec {
  # a sorting mechanism based on win-loss records of two teams against
  # each other.
  ($a, $b) = @_; # two team tags

  $tag = $a . "=" . $b;

  $ahh = $head2head{$tag} || (0, 0, 0, 0, 0);
  $a_win = @{$ahh}[0] || 0;
  $a_loss = @{$ahh}[1] || 0;
  #print ">$a - $b: " . ($head2head{$tag} ? "" : "*") . join("-", @{$ahh}) . 
  #  " (" . ($a_win <=> $a_loss) . ")\n";
  
  
  return $a_win <=> $a_loss;
}

sub by_rank {
  # This defaults to winning percentage, then fewest losses, then most wins,
  # then win-loss record, then point differential.
  # This can be modified to just about anything.
  $pct_a = ($records{$a}{"wins"} + 0.5 * $records{$a}{"ties"}) / 
    ($records{$a}{"wins"} + $records{$a}{"losses"} + $records{$a}{"ties"});
  $pct_b = ($records{$b}{"wins"} + 0.5 * $records{$b}{"ties"}) / 
    ($records{$b}{"wins"} + $records{$b}{"losses"} + $records{$b}{"ties"});

  $diff_a = $records{$a}{"pf"} - $records{$a}{"pa"};
  $diff_b = $records{$b}{"pf"} - $records{$b}{"pa"};
  #print STDERR "Sorting $a ($pct_a/$diff_a), $b ($pct_b/$diff_b) by ";

  if ($pct_a == $pct_b) { # same winning percentage; go to differential
    if ($records{$a}{"losses"} == $records{$b}{"losses"}) {
      if ($records{$a}{"wins"} == $records{$b}{"wins"}) {
	if (wlrec($a, $b) == 0) {
	  if ($diff_a == $diff_b) { # they're tied; go to the name
	    #print STDERR "name\n";
	    return $teams{$a} cmp $teams{$b};
	  } else {
	    #print STDERR "differential\n";
	    return $diff_a <=> $diff_b;
	  }
	} else {
	  return wlrec($a, $b);
	}
      } else {
	return $records{$a}{"wins"} <=> $records{$b}{"wins"};
      }
    } else {
      return $records{$b}{"losses"} <=> $records{$a}{"losses"}; # ascending
    }
  } else {
    #print STDERR "percent\n";
    return $pct_a <=> $pct_b;
  }
}

@sortedteams = sort by_rank keys(%records);  
open STANDINGS, ">stats.html" or die "Cannot open output file: $!";

$title = $options{"name"};
$page_header =~ s/TITLEHERE/$title Standings/;
print STANDINGS $page_header;
print STANDINGS "<h1>$title</h1>\n";
print STANDINGS "<h2>Standings after " . $rounds . " round" . 
  ($rounds == 1 ? "" : "s") . "</h2>\n";
print STANDINGS 
'<p>Standings: <strong>By Team</strong> - 
<a href="personal.html">By Individual</a> - 
<a href="rounds.html">By Round</a></p>';
print STANDINGS "<table class='standings'>\n";
print STANDINGS "<tr>\n" .
  "<th>&nbsp;</th>\n" .
  "<th class='number'>W</th>\n" .
  "<th class='number'>L</th>\n" .
  "<th class='number'>T</th>\n" .
  "<th class='number'>PF</th>\n" .
  "<th class='number'>PA</th>\n" .
  "</tr>";
foreach $key(reverse @sortedteams) {
  print STANDINGS "<tr>\n";
  print STANDINGS "<td><a href='stats.$key.html'>" . $teams{$key} . 
    "</a></td>\n";
  print STANDINGS "<td class='number'>" . $records{$key}{"wins"} . "</td>\n";
  print STANDINGS "<td class='number'>" . $records{$key}{"losses"} . "</td>\n";
  print STANDINGS "<td class='number'>" . $records{$key}{"ties"} . "</td>\n";
  print STANDINGS "<td class='number'>" . $records{$key}{"pf"} . "</td>\n";
  print STANDINGS "<td class='number'>" . $records{$key}{"pa"} . "</td>\n";
  print STANDINGS "</tr>";
}

print STANDINGS "</table>";
print STANDINGS $page_footer;
close STANDINGS or die "Cannot close output file: $!";