Re: Rotisserie Baseball Section

in reply to Rotisserie Baseball Section
Great idea. Here's a program I wrote a few years back. The first time you run it, you get a table with the current statistics for all your players. After that, you run it daily and it shows you how the stats have changed since the previous run--- this effectively shows how the players performed on the previous day.
It also maintains a historical archive of each player's records and a daily summary for the entire team.
I used to run this daily as a cron job, so every morning I would get a report about how my players were doing.
#!/usr/bin/perl

use HTTP::Request;
use HTTP::Response;
use LWP::UserAgent;

$ua = LWP::UserAgent->new;

sub fixup_stats (\%);

$ROOT = 'http://www.usatoday.com/sports/baseball/';
$HOME = '/data/baseball/plover-1998';
# $HOME = '/data/baseball/plover-1998/test';

%WIDTH = 
  (BB => 3, SG => 3, DB => 2, TP => 2, HR => 2, TB => 3,
   OB => 3, AB => 3, PA => 3,
   AVG => 4, OBA => 4, SLG => 4, SB => 2, CS => 2, SBG => 3, 
   R => 3, RBI => 3,

  IP => 5, ER => 3, ERA => 5, W => 2, L => 2, S => 2, WLS => 3,
  H => 3, BB => 3, BRA => 5, K => 3, BB => 3, KBB => 5,
  );

%LOCAL_STATS = 
  (BAT => [qw(BB SG DB TP HR TB OB AB PA AVG OBA SLG SB CS SBG R RBI)]
+,
   PIT => [qw(IP ER ERA W L S WLS H BB BRA K KBB)],
  );

%REMOTE_STATS =
  (BAT => [qw(AVG SLG OBA G AB R H TB DB TP HR RBI BB SO SB CS E)],
   PIT => [qw(W L ERA AVG G GS CG GF SH S IP H R ER HR BB K)],
   );

%P_TYPE = 
  ( '1B' => BAT, C => BAT, '2B' => BAT, '3B' => BAT,
    SS =>BAT, CF => BAT, OF => BAT, MI => BAT, IF => BAT,
    
    SP => PIT, RP => PIT,
  );

%DS = ('C' => 0, 
       '1B' => 1, '2B' => 2, 'SS' => 3,  '3B' => 4,
       'MI' => 3.5, 'IF' => 4.5,
       'CF' => 5,  'OF' => 6,
      );

%T_URL = (
     BAL => A1, BOS => A2, NYY => A10, TBR => A15, TOR => A14,
     CWS => A4, CLE => A5, DET => A6, KCR => A7, MIN => A9, 
     ANA => A3, OAK => A11, SEA => A12, TEX => A13, ATL => N1, 
     FLA => N5, MON => N8, NYM => N9, PHI => N10, CHC => N3, 
     CIN => N2, HOU => N6, MIL => N16, PIT => N11, STL => N14, 
     ARI => N15, COL => N4, LAD => N7, SDP => N12, SFG => N13, 
    );

%P_INFO = 
  (
    Steinbach => [C, MIN, ACT],
    McGwire => ['1B', STL, ACT],
    Graffanino => ['2B', ATL, RES],
    Caminiti => ['3B', SDP, ACT],
    Veras => ['2B', SDP, ACT],
    Anderson => [CF, BAL, ACT],
    'A. Jones' => [CF, ATL, ACT],
    Salmon => [OF, ANA, ACT],
    Loretta => [SS, MIL, ACT],
    Hammonds => [CF, BAL, RES],
    Konerko => ['3B', CIN, RES],
    Servais => [C, CHC, ACT],
 
    Santiago => [C, TOR, RES],
    Buhner => [OF, SEA, ACT],
    Rivera => [OF, SDP, RES],
    Young => ['1B', PIT, ACT],
    Strange => ['3B', PIT, RES],
    Spiers => ['3B', HOU, RES],
    Perez => ['1B', CIN, RES],
    Aurilia => ['SS', SFG, ACT],  # Signed in July draft
    
    Appier => [SP, KCR, RES],
    Glavine => [SP, ATL, ACT],
    Rueter => [SP, SFG, ACT],
    Smoltz => [SP, ATL, ACT],
    Moyer => [SP, SEA, ACT],
    Lima => [SP, HOU, ACT],    # Signed in May draft

    Jones => [RP, DET, ACT],
    Wagner => [RP, HOU, ACT],
 
    Burkett => [SP, TEX, RES],
    Blair => [SP, ARI, RES],
    Taylor => [RP, OAK, RES],
   );

################################################################


foreach $player (keys %P_INFO) {
  my ($pos, $team, $stat) = @{$P_INFO{$player}};
  push @{$players{$team}}, $player;
}

{
  my ($sec, $min, $hour, $d, $m, $y) = localtime;
  $DATE = sprintf("%04d%02d%02d", $y+1900, $m+1, $d);
  $DAILY = "DAILY-$DATE";
  $GAME = "GAME-$DATE";
  open DP, "> $HOME/$DAILY-P"
    or die "Couldn't open daily file $HOME/$DAILY-P: $!; aborting";
  open DB, "> $HOME/$DAILY-B"
    or die "Couldn't open daily file $HOME/$DAILY-B: $!; aborting";
  open GP, "> $HOME/$GAME-P"
    or die "Couldn't open game file $HOME/$GAME-P: $!; aborting";
  open GB, "> $HOME/$GAME-B"
    or die "Couldn't open game file $HOME/$GAME-B: $!; aborting";
}

my @team_queue = keys %players;
while (@team_queue) {
  my $team = shift @team_queue;
  next if $team eq XXX;        # Players not on any team
  my $url = team_url($team);
  my $request = HTTP::Request->new(GET => $url);
  my $response = $ua->request($request);

  unless ($response->is_success) {
    my $error = $response->status_line;
    print "$team($url): $error\n";
    push @team_queue, $team;
    next;
  }

  my @lines = split /\r?\n/, $response->content;
  foreach $player (@{$players{$team}}) {
    my ($ppos, $pteam, $pstat) = @{$P_INFO{$player}};
    my $ptype = $P_TYPE{$ppos};
    my @loi = grep /^$player/, @lines;
    if (@loi == 0) {
      warn "Couldn't find information for player $player on team $team
+.\n";
      next;
    } elsif (@loi > 1) {
      warn "Found multiple information for player $player on team $tea
+m.\n";
      next;
    }
    my %STATS = get_stats($player, @loi);
    fixup_stats(%STATS);
    my $pn = substr($player . "               ", 0, 15);
    my $fn = "$HOME/:$player";
    $fn =~ tr/ //d;
    my $statline = put_stats($player, %STATS);
    my $yesterday = get_last_line($fn);
    unless (open P, ">> $fn") {
      warn "Couldn't append to file `$fn': $!; skipping $player.\n";
      next;
    }
    print P $DATE, " ", $statline, "\n";

    my (%yesterday, $k);
    @yesterday{'DATE', @{$LOCAL_STATS{$ptype}}} = split /\s+/, $yester
+day;
    foreach $k (keys %STATS) {
      next unless exists $yesterday{$k};
      $yesterday{$k} = int(($STATS{$k} - $yesterday{$k})*1000)/1000;
      $TOTAL{$k} += $yesterday;
    }
    my $game_statline = put_stats($player, %yesterday);

    $statline{$player} = $statline;
    $game_statline{$player} = $game_statline;
    print STDERR "Done with player $player.\n";
  }
}
close P;

@PLAYERS = keys %P_INFO;
@PITCHERS = grep {$P_TYPE{$P_INFO{$_}[0]} eq PIT} @PLAYERS;
@BATTERS = grep {$P_TYPE{$P_INFO{$_}[0]} eq BAT} @PLAYERS;

if (open Q, "< $HOME/BHEADER-D") {
  while (<Q>) {
    print DB;
    print GB;
  }
  close Q;
} else {
  warn "Couldn't open header file BHEADER-D: $!";
}
$prevstat = 'ACT';
foreach $player (sort {$P_INFO{$a}[2] cmp $P_INFO{$b}[2]
             ||
               $DS{$P_INFO{$a}[0]} <=> $DS{$P_INFO{$b}[0]}
                 ||
                       $a cmp $b
               }
         @BATTERS) {
  next if $P_INFO{$player}[1] eq XXX;
  if ($P_INFO{$player}[2] eq RES && $prevstat eq ACT) {
    print DB "\n";
    $prevstat = RES;
  }
  my $pn = substr("$player/$P_INFO{$player}[0]             ", 0, 13);
  print DB $pn, $statline{$player}, "\n";
  print GB $pn, $game_statline{$player}, "\n";
}
print DB "\n\n";
close DB;
print GB "\n\n";
close GB;

if (open Q, "< $HOME/PHEADER-D") {
  while (<Q>) {
    print DP;
    print GP;
  }
  close Q;
} else {
  warn "Couldn't open header file PHEADER-D: $!";
}
$prevstat = 'ACT';
foreach $player (sort {$P_INFO{$a}[2] cmp $P_INFO{$b}[2]
               ||
               $P_INFO{$b}[0] cmp $P_INFO{$a}[0]
                           ||
                       $a cmp $b
               }
         @PITCHERS) {
  next if $P_INFO{$player}[1] eq XXX;
  if ($P_INFO{$player}[2] eq RES && $prevstat eq ACT) {
    print DP "\n";
    $prevstat = RES;
  }
  my $pn = substr("$player/$P_INFO{$player}[0]             ", 0, 13);
  print DP $pn, $statline{$player}, "\n";
  print GP $pn, $game_statline{$player}, "\n";
}
close DP;
close GP;

system qq{cat $HOME/$GAME-? | Mail -s 'Philadelphia Plovers Report' mj
+d};

################################################################

sub team_url {
  my $team = shift;
  my ($l, $n) = ($T_URL{$team} =~ /^([AN])(\d+)$/);
  die "Couldn't compute url for team $team; aborting" 
    unless defined $l;
  $n = sprintf("%02d", $n);
  $l = lc $l;
  $ROOT . "sb$l/sb$ {l}98$n.htm";
}


sub get_stats {
  my $player = shift;
  my $line = shift;
  $line =~ s/^\Q$player\E\s*// 
    or warn "Line of interest:\n\t$line\ndoes not begin with player's 
+name `$player'.\n";
  my @f = split /[\s-]+/, $line;
#   shift @f while $f[0] eq '';    # Discard leading null fields
  my $bp = $P_TYPE{$P_INFO{$player}[0]};
  my %stats;
  @stats{@{$REMOTE_STATS{$bp}}} = @f;
  %stats;
}

sub put_stats {
  my $player = shift;
  my %stats = @_;
  my $bp = $P_TYPE{$P_INFO{$player}[0]};
  my $statline = '';
  foreach $stat (@{$LOCAL_STATS{$bp}}) {
    my $s = fill($stats{$stat}, $WIDTH{$stat});
    if (! defined $s) {
      print STDERR "($stat)\n";
      next;
    }
    $statline .= $s . ' ';
  }
  chop $statline;
  $statline;
}

sub fill {
  my $d = shift;
  my $w = shift;
  $d =~ s/^0\././;
  $d =~ s/^-0\./-/;
  $d =~ s/0{5,}.*$//;
  if (length($d) > $w) {
    print STDERR "Couldn't fill `$d' to width $w.";
    return undef;
  }
  $d = (' ' x $w) . $d;
  substr($d, -$w);
}

sub fixup_stats (\%) {
  my $s = shift;

  # Innings pitched  12.2 => 12.7
  if (exists $s->{IP}) {
    my ($i, $f) = split /\./, $s->{IP};
    $s->{IP} = sprintf("%2.1f", $i + $f/3);
  }

  if (exists $s->{ERA}) {
    $s->{ERA} = sprintf("%.2f", int($s->{ERA} * 100)/100);
  }

  foreach $stat (qw(AVG OBA SLG)) {
    if (exists $s->{$stat}) {
      $s->{$stat} = sprintf(".%03d", int($s->{$stat} * 1000));
    }
  }

  if (exists $s->{W}) {        # Pitching
    $s->{WLS} = $s->{W} * 2 + $s->{S} - $s->{L};
    eval {$s->{BRA} = sprintf("%4.2f", 9 * ($s->{BB} + $s->{H}) / $s->
+{IP})};
    $s->{BRA} = '----' if $@;
    eval {$s->{KBB} = sprintf("%4.2f", $s->{K} / $s->{BB})};
    $s->{KBB} = '---' if $@;
  } else {            # Batting
    $s->{SG} = $s->{H} - $s->{DB} - $s->{TP} - $s->{HR};
    $s->{OB} = $s->{H} + $s->{BB};
    $s->{PA} = $s->{AB} + $s->{BB};
    $s->{SBG} = $s->{SB} - $s->{CS};
  }
}

sub get_last_line {
  my $file = shift;
  my $linelen = shift || 80;
  open Q, "< $file" || die "Couldn't open file `$file': $!; aborting";
  seek Q, -$linelen, 2;
  my $prev = undef;
  while (<Q>) {
    $prev = $_;
  }
  return $prev;
}
[download]
Comment on Re: Rotisserie Baseball Section Download Code
In Section Meditations