Football World Cup Group Stage Predictor.
perlmoth
created: 2006-05-30 18:29:51
perlmonks
prlmnks
With less than two weeks before the Football World Cup kicks off, the office sweep has appeared. I wrote the following script to help me with the group stage predictions. It makes its predictions based on the FIFA rankings: 
#!/usr/bin/perl

use strict;
use warnings;

# The following statistics are from
# http://www.fifa.com/en/mens/statistics/index/0,2548,All-May-2006,00.html

my %FIFA_points =
  ("Brazil"              => 827,
   "Czech Republic"      => 772,
   "Holland"             => 768,
   "Mexico"              => 758,
   "Spain"               => 756,
   "USA"                 => 756,
   "Portugal"            => 750,
   "France"              => 749,
   "Argentina"           => 746,
   "England"             => 741,
   "Italy"               => 728,
   "Sweden"              => 709,
   "Japan"               => 705,
   "Germany"             => 696,
   "Tunisia"             => 693,
   "Iran"                => 686,
   "Croatia"             => 686,
   "Costa Rica"          => 683,
   "Poland"              => 677,
   "South Korea"         => 677,
   "Ivory Coast"         => 669,
   "Paraguay"            => 653,
   "Saudi Arabia"        => 651,
   "Switzerland"         => 648,
   "Ecuador"             => 631,
   "Australia"           => 612,
   "Serbia & Montenegro" => 610,
   "Ukraine"             => 609,
   "Trinidad & Tobago"   => 604,
   "Ghana"               => 600,
   "Angola"              => 581,
   "Togo"                => 569
  );

my %groups =
 (A => ["Germany",     "Costa Rica",     "Poland",              "Ecuador"],
  B => ["England",     "Paraguay",       "Trinidad & Tobago",   "Sweden"],
  C => ["Argentina",   "Ivory Coast",    "Serbia & Montenegro", "Holland"],
  D => ["Mexico",      "Iran",           "Angola",              "Portugal"],
  E => ["USA",         "Czech Republic", "Italy",               "Ghana"],
  F => ["Australia",   "Japan",          "Brazil",              "Croatia"],
  G => ["South Korea", "Togo",           "France",              "Switzerland"],
  H => ["Spain",       "Ukraine",        "Tunisia",             "Saudi Arabia"]
 );

my @combinations = ([0, 1], [2, 3], [0, 2], [3, 1], [3, 0], [1, 2]);

for ("A" .. "H") {
  print STDERR "\nGroup $_:\n";
  my $group = $groups{$_};
  foreach (@combinations) {
    my $a = $group->[$_->[0]];
    my $b = $group->[$_->[1]];
    my $home_advantage = $FIFA_points{$a} - $FIFA_points{$b};
    my $score = get_score($home_advantage);
    print STDERR "$a vs $b ($score)\n";
  }
}

sub get_score {
  my ($points_diff) = @_;
  my $score = 0;
  my $other = 0;
  if (abs $points_diff <= 30) {
    $score = 0;
  }
  elsif (abs $points_diff <= 80) {
    $score = 1;
  }
  elsif (abs $points_diff <= 130) {
    $score = 2;
  }
  elsif (abs $points_diff <= 200) {
    $score = 3;
  }
  else {
    $score = 4;
  }

  my $random_factor = rand;
  if ($random_factor > 0.9) {
    $score += 2;
    $other += 2;
  }
  elsif ($random_factor <= 0.9 and $random_factor > 0.75) {
    $score += 1;
    $other += 1;
  }

  if ($points_diff == abs $points_diff) {
    return "${score}-${other}";
  }
  else {
    return "${other}-${score}";
  }
}


Any comments or suggested improvements would be gratefully received.
Re: Football World Cup Group Stage Predictor.
wfsp
created: 2006-05-31 02:51:18
perlmonks
prlmnks
perlmoth++

The English want to know who the Scots will be cheering for. ;-)

wfsp

Re^2: Football World Cup Group Stage Predictor.
lukeyboy1
created: 2006-05-31 05:49:59
perlmonks
prlmnks
My Trinidadian-Paraguayan-Swedish grandparents have told me "anyone that england are playing against...."

:)

PS I used to live in England. In was the only one to order a pint of Kronenburg after that Zidane goal.....!
PPS BTW - It's not an irrational hatred of the English - I just don't want to hear about another World Cup Win for 40 years....! :)
Re^3: Football World Cup Group Stage Predictor.
lukeyboy1
created: 2006-05-31 08:42:28
perlmonks
prlmnks
Here's a CGI version with some code to generate the tables at the end too....Hacked together in my lunch hour: apologies for the non-english names, but hey......! 
#!/usr/bin/perl

use strict;
use warnings;
use CGI;
my $q = new CGI;                        # create new CGI object
print $q->header;                   # create the HTTP header


# The following statistics are from
# http://www.fifa.com/en/mens/statistics/index/0,2548,All-May-2006,00.html

my %FIFA_points =
  ("Brazil"              => 827,
   "Czech Republic"      => 772,
   "Holland"             => 768,
   "Mexico"              => 758,
   "Spain"               => 756,
   "USA"                 => 756,
   "Portugal"            => 750,
   "France"              => 749,
   "Argentina"           => 746,
   "England"             => 741,
   "Italy"               => 728,
   "Sweden"              => 709,
   "Japan"               => 705,
   "Germany"             => 696,
   "Tunisia"             => 693,
   "Iran"                => 686,
   "Croatia"             => 686,
   "Costa Rica"          => 683,
   "Poland"              => 677,
   "South Korea"         => 677,
   "Ivory Coast"         => 669,
   "Paraguay"            => 653,
   "Saudi Arabia"        => 651,
   "Switzerland"         => 648,
   "Ecuador"             => 631,
   "Australia"           => 612,
   "Serbia & Montenegro" => 610,
   "Ukraine"             => 609,
   "Trinidad & Tobago"   => 604,
   "Ghana"               => 600,
   "Angola"              => 581,
   "Togo"                => 569
  );

my %groups =
 (A => ["Germany",     "Costa Rica",     "Poland",              "Ecuador"],
  B => ["England",     "Paraguay",       "Trinidad & Tobago",   "Sweden"],
  C => ["Argentina",   "Ivory Coast",    "Serbia & Montenegro", "Holland"],
  D => ["Mexico",      "Iran",           "Angola",              "Portugal"],
  E => ["USA",         "Czech Republic", "Italy",               "Ghana"],
  F => ["Australia",   "Japan",          "Brazil",              "Croatia"],
  G => ["South Korea", "Togo",           "France",              "Switzerland"],
  H => ["Spain",       "Ukraine",        "Tunisia",             "Saudi Arabia"]
 );

my @combinations = ([0, 1], [2, 3], [0, 2], [3, 1], [3, 0], [1, 2]);
my %pts;
my %for;
my %against;

print qq~



 World Cup Results Generator


~;
print "\n";
for ("A" .. "H") {
  print "\n
Group $_:
\n";
  my $group = $groups{$_};
  foreach (@combinations) {
    my $a = $group->[$_->[0]];
    my $b = $group->[$_->[1]];
    my $home_advantage = $FIFA_points{$a} - $FIFA_points{$b};
    my $score = get_score($home_advantage);
    print "
$a vs $b ($score)\n";
    calc_points($a, $b, $score);
    
  }
}

print "\n";
for ("A" .. "H") {
  
  my $groupname = $_;
  my $group = $groups{$_};
  
  my @list = ();
  my $team;
  foreach $team (@$group) {
    my $pts_total = $pts{$team};
    my $gf = $for{$team};
    my $ga = $against{$team};
    my $diff = $gf - $ga;
    $diff = $diff / 100 + ($gf / 1000);
    my $adj_pts = $pts_total + $diff;
    my $string = sprintf("%02.4f|%02d|$team|$gf|$ga", $adj_pts,$pts_total);
    push(@list, $string);
  }
  my @list2 = sort(@list);
  @list2 = reverse(@list2);
  
  show_group($groupname, \@list2);
}

$q->end_html;

sub show_group {
  my $name = shift;
  my $reflist = shift;
  
  print "\n
Standings: Group $name
";
  #print @$reflist;
  print "";
  foreach (@$reflist) {
    my($adj, $pts, $team, $gf, $ga) = split(/\|/, $_);
    print "\n";
    printf("", $gf, $ga, $pts);
  
  }
  print "
TeamFAPts
 $team%2d%2d%2d
";

}

sub calc_points {
  my $hm = shift;
  my $aw = shift;
  my $score = shift;
  my($hg, $ag) = split(/\-/, $score, 2);
  if($hg > $ag) {
    add_pts($hm, 3);
  }
  elsif($ag > $hg) {
    add_pts($aw, 3);
  }
  else {
    add_pts($aw, 1);
    add_pts($hm, 1);
  }
  update_gd($hm, $hg, $ag);
  update_gd($aw, $ag, $hg);
}

sub add_pts {
  my $tm = shift;
  my $pts = shift;
  
  my $tot = $pts{$tm} || 0;
  $tot += $pts;
  $pts{$tm} = $tot;

}

sub update_gd {
  my $tm = shift;
  my $f = shift;
  my $a = shift;
  
  my $gf = $for{$tm} || 0;
  my $ga = $against{$tm} || 0;
  
  $gf += $f;
  $for{$tm} = $gf;
  
  $ga += $a;
  $against{$tm} = $ga;
}

sub get_score {
  my ($points_diff) = @_;
  my $score = 0;
  my $other = 0;
  if (abs $points_diff <= 30) {
    $score = 0;
  }
  elsif (abs $points_diff <= 80) {
    $score = 1;
  }
  elsif (abs $points_diff <= 130) {
    $score = 2;
  }
  elsif (abs $points_diff <= 200) {
    $score = 3;
  }
  else {
    $score = 4;
  }

  my $random_factor = rand;
  if ($random_factor > 0.85) {
    $score += 2;
    $other += 2;
  }
  elsif ($random_factor <= 0.95 and $random_factor > 0.60) {
    $score += 1;
    $other += 1;
  }
  
  
  
  if($random_factor > 0.95) {
    # a surprise result
    my $var = rand();
    if($var > 0.5) {
      $other = 1;
      $score = 0;
    }
    else {
      $score = 1;
      $other = 0;
    } 
  
  }

  if ($points_diff == abs $points_diff) {
    return "${score}-${other}";
  }
  else {
    return "${other}-${score}";
  }
}
Re^4: Football World Cup Group Stage Predictor.
lukeyboy1
created: 2006-05-31 09:13:24
perlmonks
prlmnks
definitely perlmoth++ btw... :)
Re^2: Football World Cup Group Stage Predictor.
Tobin Cataldo
created: 2006-05-31 10:20:32
perlmonks
prlmnks
Not the English...
I heard the Poles are going to beat up all the English.

update:
I only speak the truth
Re^2: Football World Cup Group Stage Predictor.
marto
created: 2006-05-31 10:34:04
perlmonks
prlmnks
Well I (a Scotsman) won't be cheering for any of the teams.
I fail to see the point of any game when the rules of play are broken.

And yes, I would have exactly the same response if the Scottish national squad had managed to make it cheat their way into the competition :)

Martin

Update for clarification: This is, of course, a personal view, and applies to all sports. I would much rather go out and do some sort of exercise (be it cycle, rock climbing or even a walk) than watch someone else have fun and exercise for 90 minutes (or however long the game lasts).

perlmonks.org content © perlmonks.org and lukeyboy1, marto, perlmoth, Tobin Cataldo, wfsp

prlmnks.org © 2006 edmund von der burg (eccles & toad)

v 0.03