SHARE
TWEET

Untitled

a guest Oct 20th, 2019 107 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4.  
  5. my $file = $ARGV[0] or die "No file specified";
  6. my $outdir = $ARGV[1] or die "no outdir specified";
  7. mkdir $outdir unless (-e $outdir);
  8.  
  9. my %scores = ();
  10. my %power = ();
  11. my %weird = ();
  12. my %teamCnt = ();
  13. my %volatile = ();
  14.  
  15. sub read_csv($) {
  16.     my $file = shift;
  17.     open(DATA, '<', $file) or die "could not open $file";
  18.     my $header = <DATA>;
  19.     chomp $header;
  20.     my ($homeTeam, $homeScore, $awayTeam, $awayScore) = (0, 0, 0, 0);
  21.     my @fields = split(/,\s*/, $header);
  22.     for my $i (0 .. $#fields) {
  23.         if ($fields[$i] =~ /home_team/i) {
  24.             $homeTeam = $i;
  25.         }
  26.         if ($fields[$i] =~ /away_team/i) {
  27.             $awayTeam = $i;
  28.         }
  29.         if ($fields[$i] =~ /home_points/i) {
  30.             $homeScore = $i;
  31.         }
  32.         if ($fields[$i] =~ /away_points/i) {
  33.             $awayScore = $i;
  34.         }
  35.     }
  36.     my $i = 0;
  37.     while (my $line = <DATA>){
  38.         chomp $line;
  39.         @fields = split(/,\s*/, $line);
  40.         next if ($fields[$homeScore] eq '');
  41.         $scores{$i}{'t1'} = $fields[$homeTeam];
  42.         $scores{$i}{'t1s'} = $fields[$homeScore];
  43.         $teamCnt{$fields[$homeTeam]} = (exists $teamCnt{$fields[$homeTeam]}) ? $teamCnt{$fields[$homeTeam]} + 1 : 1;
  44.  
  45.         $scores{$i}{'t2'} = $fields[$awayTeam];
  46.         $scores{$i}{'t2s'} = $fields[$awayScore];
  47.         $teamCnt{$fields[$awayTeam]} = (exists $teamCnt{$fields[$awayTeam]}) ? $teamCnt{$fields[$awayTeam]} + 1 : 1;
  48.  
  49.         $i++;
  50.     }
  51.  
  52.     #foreach my $tm (sort { $teamCnt{$b} <=> $teamCnt{$a} } (keys %teamCnt)){
  53.         # DBG missing data issues
  54.         #print "$teamCnt{$tm} $tm\n";
  55.     #}
  56.  
  57.     open(REMOVED, '>', "$outdir/removed.txt") or die "couldn't open removed.";
  58.     # Remove teams who have too few connections to the dataset.
  59.     my $removed;
  60.     do {
  61.         $removed = 0;
  62.         foreach my $team (keys %teamCnt) {
  63.             if ($teamCnt{$team} le 3) {
  64.                 if ($teamCnt{$team} ge 3) {
  65.                     print "$team\n";
  66.                     next;
  67.                 }
  68.                 foreach my $matchup (keys %scores) {
  69.                     #next unless (exists $scores{$matchup});
  70.                     if ($scores{$matchup}{'t1'} eq $team or $scores{$matchup}{'t2'} eq $team) {
  71.                         $teamCnt{$scores{$matchup}{'t2'}}--;
  72.                         $teamCnt{$scores{$matchup}{'t1'}}--;
  73.                         delete $scores{$matchup};
  74.                         $removed++;
  75.                     }               }
  76.                 delete $teamCnt{$team} unless ($teamCnt{$team} ge 1);
  77.                 print REMOVED "Removed $team\n";
  78.             }
  79.         }
  80.     } while ($removed gt 0);
  81.     close(REMOVED);
  82.  
  83.     #foreach my $tm (sort { $teamCnt{$b} <=> $teamCnt{$a} } (keys %teamCnt)){
  84.         # DBG missing data issues
  85.         #print "$teamCnt{$tm} $tm\n";
  86.     #}
  87.  
  88. }
  89.  
  90. sub calculate_importance($$) {
  91.     my ($powerDiff, $scoreDiff) = @_;
  92.     if ($powerDiff lt 0) {
  93.         # It's easier to think from the perspective of the higher ranked team.
  94.         $powerDiff = 0 - $powerDiff;
  95.         $scoreDiff = 0 - $scoreDiff;
  96.     }
  97.     # Close games and upsets get capped at weight 1.2 - NVM, no reason to.
  98.     #if ($scoreDiff le -10) {
  99.     #   return 1.2;
  100.     #}
  101.     # by capping at this point value we ensure nobody will get fewer power for scoring more.
  102.     if ($scoreDiff ge 55){
  103.         return .55;
  104.     }
  105.     # Calculate importance of game which decreases as blowout status goes up.
  106.     # 10 pt win = 1
  107.     # 20 pt win = .9
  108.     # 30 pt win = .8
  109.     # 40 pt win = .7
  110.     # 50 pt win = .6
  111.     # 55+pt win = .55 - magical cutoff where higher victories would mean less points for winning.
  112.     return (1 - (($scoreDiff - 10)/100));
  113. }
  114.  
  115. sub calculate_deltas($$$$){
  116.     my ($t1Power, $t2Power, $scoreDiff, $velocity) = @_;
  117.     # scoreDiff = t1 - t2, so t1 should go up if they win big
  118.     my $t1Target = $t2Power + $scoreDiff;
  119.     my $t2Target = $t1Power - $scoreDiff;
  120.     $velocity = $velocity* calculate_importance($t1Power - $t2Power, $scoreDiff);
  121.     return ((($t1Target-$t1Power)*$velocity),(($t2Target-$t2Power)*$velocity));
  122. }
  123.  
  124. sub init_power() {
  125.     foreach my $i (keys %scores) {
  126.         $power{$scores{$i}{'t1'}} = 100;
  127.         $power{$scores{$i}{'t2'}} = 100;
  128.     }
  129. }
  130.  
  131. sub run_round($) {
  132.     my ($velocity) = @_;
  133.     my %new_power = %power;
  134.     foreach my $i (keys %scores) {
  135.         my $t1p = $power{$scores{$i}{'t1'}};
  136.         my $t2p = $power{$scores{$i}{'t2'}};
  137.         my $diff = $scores{$i}{'t1s'} - $scores{$i}{'t2s'};
  138.         my ($d1, $d2) = calculate_deltas($t1p, $t2p, $diff, $velocity);
  139.         $new_power{$scores{$i}{'t1'}} += $d1;
  140.         $new_power{$scores{$i}{'t2'}} += $d2;
  141.     }
  142.     %power = %new_power;
  143. }
  144.  
  145. sub print_sorted_power(%){
  146.     my %pwr = @_;
  147.     my @sorted = sort {$pwr{$b} <=> $pwr{$a}} (keys %pwr);
  148.     open (RESULTS, '>', "$outdir/results.txt") or die "Couldn't open results";
  149.     foreach my $team (@sorted) {
  150.         print RESULTS "$team: $pwr{$team}\n";
  151.     }
  152. }
  153.  
  154.  
  155. read_csv($file);
  156. init_power();
  157. my $roundMax = 4000;
  158. my $velConst = 0.1;
  159. for (my $r = 0; $r < $roundMax; $r++) {
  160. #   my $velocity = $velConst - $velConst*($r/$roundMax);
  161. #   run_round($velocity);
  162.     run_round($velConst);
  163. }
  164.  
  165.  
  166. print_sorted_power(%power);
  167.  
  168. foreach my $tm (keys %teamCnt) {
  169.     $volatile{$tm} = 0;
  170. }
  171.  
  172. foreach my $i (keys %scores) {
  173.     my $t1p = $power{$scores{$i}{'t1'}};
  174.     my $t2p = $power{$scores{$i}{'t2'}};
  175.     my $diff = ($scores{$i}{'t1s'} - $scores{$i}{'t2s'}) - ($t1p -$t2p) ;
  176.     my $name = $scores{$i}{'t1'} . '-' . $scores{$i}{'t2'};
  177.     $weird{$name} = $diff;
  178.     $volatile{$scores{$i}{'t1'}} += abs($diff);
  179.     $volatile{$scores{$i}{'t2'}} += abs($diff);
  180. }
  181.  
  182. open (WEIRD_GAMES, '>', "$outdir/weird_games.txt") or die "Couldn't open weird games";
  183. foreach my $wtf (sort {abs($weird{$b}) <=> abs($weird{$a})} (keys %weird)) {
  184.     print WEIRD_GAMES "$wtf $weird{$wtf}\n";
  185. }
  186. close (WEIRD_GAMES);
  187.  
  188.  
  189. open (WEIRD_TEAMS, '>', "$outdir/weird_teams.txt") or die "Couldn't open weird teams";
  190. foreach my $v (sort {$volatile{$b} / $teamCnt{$b} <=> $volatile{$a} / $teamCnt{$a}} (keys %volatile)) {
  191.     my $volAve = $volatile{$v} / $teamCnt{$v};
  192.     print WEIRD_TEAMS "$v  $volAve\n";
  193. }
  194. close(WEIRD_TEAMS);
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top