Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Re: Rotisserie Baseball Section

by Dominus (Parson)
on Apr 14, 2001 at 22:20 UTC ( #72600=note: print w/ replies, xml ) Need Help??


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


Comment on Re: Rotisserie Baseball Section
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://72600]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (8)
As of 2014-07-24 08:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (158 votes), past polls