#
# $Header: /home/whelan/cvsroot/joetbrw/lib/modpairwise.pl,v 1.3 2002/01/17 04:56:42 whelan Exp $
#

require 'common.pl';
use KRACH;

sub wlt {
    my ($w,$l,$t)=@_;
    if (ref $w) {
	($w,$l,$t)=($w->w,$w->l,$w->t);
    }
    if ($t) {
	return "$w-$l-$t";
    }
    else {
	return "$w-$l";
    }
}

sub initscores {
    my $infile=shift;
    my ($date,$team1,$score1,$team2,$score2,$fh,$gmpts);
    my $lastdate;
    if ($infile) {
	sysopen (SCORES, $infile, O_RDONLY) or die $!;
	$fh = *SCORES;
    }
    else {
	$fh = *STDIN;
    }
    while (<$fh>) {
	next if substr($_,0,1) eq '#';
	($date,$team1,$score1,$team2,$score2,$conf)=split;
	if ($date >= $stopdate) {
	    last;
	}
	$lastdate = $date;
	if (exists $name{$team1} and exists $name{$team2}) {
	    Team->game($team1=>$score1, $team2=>$score2);
	}
    }
    if ($infile) {
	close SCORES or die $!;
    }
    return $lastdate;
}

sub pairwise {
# pairwise($a,$b) returns the net number of comparisons won by $a over $b
# if that is a tie, it returns the difference in the RPIs of the two teams,
# which will always have absolute value less than one.
# Note that this means one needs to sort by pairwise($a,$b)<=>0 and not
# simply by pairwise($a,$b)

    my ($aa,$bb) = @_;
# Head-to-head 
    my $pairwise=($aa->pf($bb)-$bb->pf($aa))/2;
# RPI
    $pairwise += $aa->rpi<=>$bb->rpi;
# The rest
    $pairwise += $aa->tuc($bb)->pct<=>$bb->tuc($aa)->pct;
    $pairwise += $aa->Last(8)->pct<=>$bb->Last(8)->pct;
    $pairwise += $aa->common($bb)->pct<=>$bb->common($aa)->pct;
    return $pairwise || ($aa->rpi-$bb->rpi);
}

sub kpairwise {
# kpairwise($a,$b) returns the net number of comparisons won by $a over $b
# in the modified pairwise comparison system, as with pairwise($a,$b)

    my ($aa,$bb) = @_;
# Head-to-head 
    my $pairwise=($aa->pf($bb)-$bb->pf($aa))/2;
# RRWP
    $pairwise += $aa->rrwp<=>$bb->rrwp;
# vs TUC
    $pairwise += $aa->tuc($bb)->hhwp($bb->tuc($aa)) <=> .5;
# Last 16       
    $pairwise += $aa->Last(8)->hhwp($bb->Last(8)) <=> .5;
# common opponents
    $pairwise += $aa->common($bb)->hhwp($bb->common($aa)) <=> .5;
    return $pairwise || (2*$aa->hhwp($bb)-1);
}

sub pwsort {
    my ($i,$j);
    my @team=@{shift @_};
    my $lpwr = shift @_ || &pwr(@team);
    return unless @team;
    @team=sort {$lpwr->{$b->abbr}<=>$lpwr->{$a->abbr}
		 or $b->data('PWC')->{$a->abbr} <=> 0} @team; 
    if ($lpwr->{$team[0]->abbr}==$lpwr->{$team[-1]->abbr}) {
	return sort {$b->rpi<=>$a->rpi} @team;
    }
    OUTER: for ($i=0; $i<$#team-1; ++$i) {
 	for ($j=$#team; $i<$j-1; --$j) {
	    if ($lpwr->{$team[$i]->abbr} == $lpwr->{$team[$j]->abbr}) {
		@team[$i..$j]=pwsort([@team[$i..$j]]);
		$i=$j;
		next OUTER;
	    }
	}
    }
    return @team;
}

sub kpwsort {
    my ($i,$j);
    my @team=@{shift @_};
    my $lpwr = shift @_ || &kpwr(@team);
    return unless @team;
    @team=sort {$lpwr->{$b->abbr}<=>$lpwr->{$a->abbr}
		 or $b->data('KPWC')->{$a->abbr} <=> 0} @team; 
    if ($lpwr->{$team[0]->abbr}==$lpwr->{$team[-1]->abbr}) {
	return sort {$b->rrwp<=>$a->rrwp} @team;
    }
    OUTER: for ($i=0; $i<$#team-1; ++$i) {
 	for ($j=$#team; $i<$j-1; --$j) {
	    if ($lpwr->{$team[$i]->abbr} == $lpwr->{$team[$j]->abbr}) {
		@team[$i..$j]=&kpwsort([@team[$i..$j]]);
		$i=$j;
		next OUTER;
	    }
	}
    }
    return @team;
}

sub pwr {
    my %pwr;
	foreach $team (@_) {
	    $pwr{$team->abbr}=0;
	    foreach (@_) {
		++ $pwr{$team->abbr} if $team->data('PWC')->{$_->abbr}>0;
	    }
	}
    return \%pwr;
}

sub kpwr {
    my %pwr;
	foreach $team (@_) {
	    $pwr{$team->abbr}=0;
	    foreach (@_) {
		++ $pwr{$team->abbr} if $team->data('KPWC')->{$_->abbr}>0;
	    }
	}
    return \%pwr;
}

sub kpct {
    my $team=shift;
    if (ref $team eq 'Criterion' and not $team->connection($team->team,'~')) {
	return &pct($team->hhwp($team->team),'p');
    }
    else {
	return &pct(1/(1+1/$team->krach),'p');
    }
}

sub fivek {
    my ($crit,$team,$oppcrit)=@_;
    my $conn=$crit->connection($team);
    if ($conn eq '~') {
	return &five(100*$crit->krach($oppcrit));
    }
    elsif ($conn eq '>') {
	return '&infin;';
    }
    elsif ($conn eq '<') {
	return '0';
    }
    else {
	return 'N/A';
    }
}

1;