Dominic J. Thoreau

build-rank.teams.pl

~\Desktop\prem2005\build-rank.teams.pl.html

#! /perl/bin/perl

# Rank all matches, divisions don't matter here

# Seriously, don't run this script. It takes hours to run. I believe it's 
# an efficieny problem with MySQL's UPDATE. Best work with the import-matches 
# script.

use strict;
use DOM_DB;
$|=1;

my $dbh=&db_connect('premiership');

my $sql='SELECT id, start_rate FROM teams';
my $csr=&select_sql($sql);

my ($tid, $rank);
my %tr=();

while (($tid,$rank)=$csr->fetchrow) {
        $tr{$tid}=$rank;
}
$csr->finish;


$sql='SELECT home, visitor, hscore, vscore, date FROM results';
$csr=&select_sql($sql);

my ($rh, $rv); # decimal chance of home, visitor win

my $rec_count=0;

# Variable names are short to keep code tidy
#  NAMING CONVENTIONS
#  h = home v=visitor s=score p=predicted a=actual c=change
my ($ht,$vt,$hs,$vs,$md);
my ($ph,$pv,$ah,$av,$ch,$cv,$gd);
while (($ht,$vt,$hs,$vs,$md)=$csr->fetchrow) {
        $rec_count++;
        if ($rec_count == 50) { print '.'; $rec_count=0;}
        # predict probable outcomes.
        $ph=1/(1+10**(($tr{$vt}-$tr{$ht})/400));
        $pv=1/(1+10**(($tr{$ht}-$tr{$vt})/400));

        # It could be all 1 big if, but this looks better
        if ($hs > $vs )         { $ah=1; $av=0; }
        if ($hs < $vs )         { $ah=0; $av=1; }
        if ($hs == $vs )        { $ah=0.5;$av=0.5;}

        #print "$hs - $vs : $ph - $pv\n";

        $gd=abs($hs-$vs); if ($gd==0) { $gd=1; }
        $ch=int(($ah-$ph) * 16 * $gd);
        $cv=int(($av-$pv) * 16 * $gd);

        $sql=q{ 
        UPDATE results 
        SET hrank_old =?, vrank_old=?, hrank_new=?, vrank_new=?  
        WHERE home=? AND date=?  
        };

        &exec_sql($sql,$tr{$ht},$tr{$vt},$tr{$ht}+$ch,$tr{$vt}+$cv,$ht,$md);
        $tr{$vt}+=$cv; $tr{$ht}+=$ch;
}
$csr->finish;
$sql='UPDATE teams SET rate= ? WHERE id=?';
my $team;
foreach $team ( keys %tr) {
        &exec_sql($sql,$tr{$team},$team);
}

© 2004 Dominic J. Thoreau - this is http://www.thoreau-online.net/build-rank.teams.pl.html
Updated and uploaded Fri Dec 29 11:45:07 2006