Swiss aka Round Robin

Please Register to submit score.

Average Score	0.0
Scores Submitted	0
Date Added	Jul 02, 2007
Last Updated	Jul 02, 2007
Tags	robinbot swissround

Introduction

i made this code when i was working with Magic-league, now that i am no longer with magic-league i will let my swiss code free.

Grab the Code

# $y = &erf($x) - normalized error function
sub erf { &erf2($_[0]/1.414213562373095); }

# $y = &erf2($x) - unnormalized error function
sub erf2 { 
  local($x)=$_[0];
  $x >= 4 ? return 1 : $x <= -4 ? return 0 : 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(rating1, rating2)
sub outcome { local($_) = &erf2(($_[0]-$_[1])/400); ($_, 1-$_); }

# (E(win)) = &outcome_cached(difference in ratings)
sub outcome_cached { 
  $ratings'ocache{$_[0]} || ($ratings'ocache{$_[0]}=&erf2($_[0]/400));
  }

# @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;
  }

# very simple binary search
sub search4 { local(*sub, $low, $high, $thresh) = @_; local($mid);
  while ($high - $low > $thresh) {
    $mid = ($low+$high)/2;
    if (&sub($mid) < 0) { $low = $mid; } else { $high = $mid; }
    }
  $mid;
  }

# &load_ratings - load Magic-league 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 (<HANDLE>) { 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 (<HANDLE>) { 
    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;

Comments

(0) RSS

Go to Bottom

Swiss aka Round Robin

Introduction

Grab the Code

Comments

LordHawk

My Snippet Tags

Contact

Sponsors


Last seen: Jul 05, 2008 Profile Snippets (4) Comments Received (8) Comments Submitted (18) Forum Posts (39)