# ratings.pl - Perl library of routines for manipulating NSA Elo ratings # Copyright (C) 1996 by John J. Chew, III # All Rights Reserved # ratings.pl # $y = &erf($x) - normalized error function sub erf { &erf2($_[0]/1.414213562373095); } # $y = &erf2($x) - unnormalized error function sub erf2 { local($x)=$_[0]; local($n,$sum,$term,$x2) = (0, 0.5, $x/1.772453850905516, $x*$x); while ($term > 1E-10 || $term < -1E-10) { $n++; $sum += $term; $term *= - ($x2 * ($n+$n-1))/(($n+$n+1) * $n); } $sum; } # (E(win),E(loss)) = &outcome(difference in ratings) sub outcome { local($_) = &erf2(($_[0]-$_[1])/400); ($_, 1-$_); } # @lines = &format_table($columns, @align, @row1, @row2, ...) sub format_table { local($columns, @data) = @_; local($i, $j, $l, @align, @width, @lines); # initialise widths @width = (0) x $columns; # extract alignments @align = splice(@data, 0, $columns); # measure columns $j = 0; for $i (@data) { $l = length($i); $width[$j] = $l if $width[$j] < $l; $j = 0 if ++$j == $columns; } # format rows @lines = (); $j = 0; for $i (@data) { local($pad) = ' ' x ($width[$j] - length($i)); push(@lines, '') unless $j; $lines[$#lines] .= ($align[$j] eq 'l') ? "$i$pad " : "$pad$i "; $j = 0 if ++$j == $columns; } for $i (@lines) { $i =~ s/ $//; } @lines; } # $i = &round($f) - round to nearest integer sub round { int($_[0] + ($_[0] >=0 ? 0.5 : -0.5)); } # very simple binary search sub search { local(*sub, $low, $high) = @_; local($mid); while ($high - $low > 1) { $mid = int(($low+$high)/2); if (&sub($mid) < 0) { $low = $mid; } else { $high = $mid; } } $mid; } # &load_ratings - load DOoM ratings database sub load_ratings { local($database, $lines_only) = @_; local(@fields, $i, $player, $spread); if ((!-f "$database.fmt") || -M _ > -M "$database.db") { open(HANDLE, "<$database.db") || die "open($database.db): $!\n"; while () { chop; s/\s*#.*$//; next unless length; @_ = split; for $i (1..2) { $player = $_[$i]; $rating{$player} = $_[6+$i]; $games{$player}++; $spread = $_[2+$i] - $_[5-$i]; if ($spread > 0) { $wins{$player}++; } elsif ($spread < 0) { $losses{$player}++; } else { $ties{$player}++; } $last{$player} = $_[0] if $last{$player} < $_[0]; } } close(HANDLE); &make_fmt_file($database); } open(HANDLE, "<$database.fmt") || die "open($database.fmt): $!\n"; while () { last if $_ eq "EOF\n"; push(@lines, $_); next if $lines_only; next unless /^\s*[-\d]/; chop; s/^\s+//; ($rank, $player, @fields) = split(/\s+/); die "Bad line in $database.fmt: $_\n" unless $#fields == 4; ($rating{$player}, $wins{$player}, $losses{$player}, $ties{$player}, $last{$player}) = @fields; $games{$player} = $wins{$player} + $losses{$player} + $ties{$player}; } close(HANDLE); die "$database.fmt is incomplete.\n" unless $_ eq "EOF\n"; } # &make_fmt_file - create DOoM cached results file sub make_fmt_file { local($database) = @_; local($player); open(HANDLE, ">$database.fmt") || die "open(>$database.fmt): $!\n"; @cells = (7, 'r', 'l', 'r', 'r', 'r', 'r', 'l', 'Rank', 'Player', 'Rating', 'Won', 'Lost', 'Tied', 'Last'); $last=''; $rank=0; $tiedPlayers = 1; for (sort { $rating{$b} <=> $rating{$a} || $wins{$b} <=> $wins{$a} || $losses{$a} <=> $losses{$b} || $ties{$b} <=> $ties{$a} || $last{$b} <=> $last{$a} || $a cmp $b } keys %last) { if (/^\*/) { next; $thisrank = '-'; } else { if (length($last) && $rating{$_} == $rating{$last} && $wins{$_} == $wins{$last} && $losses{$_} == $losses{$last} && $ties{$_} == $ties{$last} && $last{$_} == $last{$last}) { $tiedPlayers++; } else { $rank+=$tiedPlayers; $tiedPlayers=1; $last=$_; } $thisrank = $rank; } $wins{$_} = 0 unless defined $wins{$_}; $losses{$_} = 0 unless defined $losses{$_}; $ties{$_} = 0 unless defined $ties{$_}; push(@cells, $thisrank, $_, $rating{$_}, $wins{$_}, $losses{$_}, $ties{$_}, $last{$_}); } print HANDLE join("\n", &format_table(@cells)), "\nEOF\n"; close(HANDLE); } 1;