Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
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 romping around the Monastery: (14)
As of 2015-07-28 11:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (254 votes), past polls