Baseball-Sabermetrics

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

Revision history for Baseball::Sabermetrics

0.01    May. 30 2006
        Welcome to Sabermetrics world.

0.02
	More built-in formula.
	Simple error detection.
	use b1, b2, b3 instead of 1b, 2b, 3b

0.03
	Fix several bugs for League::CPBL
	Usability improvement
	Keep working on ws.pl with Tsao

lib/Baseball/Sabermetrics.pm  view on Meta::CPAN

  # Actually these are predefined.
  # Those data with 'p_' or '_allowed' here are for seperating pitchers
  # and batters.

  $league->define(
      rc => 'ab * obp',
      babip => '(h_allowed - hr_allowed) / (p_pa - h_allowed - p_so - p_bb - hr_allowed',
      # what started with '$' will be reserved.
      # Players have team and league predefined, and team has league.
      formula1 => 'hr / $_->team->hr';
      formula2 => 'hr / $_->league->hr';
      complex => sub {
	    print "You can write a sub directly\n";
	    $_->slg - $_->ba;
      },
      ...
  );

  # Some formulas can be applied to players, teams, and league, depend on what
  # columns are used in the formula.  For example, ab and obp are defined for
  # players, teams, and league, so that rc is available for all of them.

  # top 5 obp of teams
  $_->print qw/ team name ba obp slg isop / for $league->top('teams', 5, 'obp');

  # top 10 obp of players
  $_->print qw/ team name ba obp slg isop / for $league->top('players', 10, 'obp');

  # show a player's information
  $league->players('Chien-Ming Wang')->print qw/ win lose ip so bb whip go_ao /;

lib/Baseball/Sabermetrics.pm  view on Meta::CPAN

  # show team statistics data (accumulated from players')
  $league->{Yankees}->print qw/ win lose ip so bb whip go_ao /;

  # give a brief report for pitchers/batters of the team
  $league->{Yankees}->report_pitchers qw/ name ip p_so p_bb whip go_ab /;
  $league->{Yankees}->report_batters  qw/ name ba obp slg isop /;

  $league->report_teams qw/ name win lose era obp /;

  # show all available formula
  print join ' ', $league->formula_list;

=head1 Data Structure

Baseball::Sabermetrics is aimed for providing a base class of your interested teams (a league, for example).  You'll need to provide a data retriever to pull data out.  The following example shows how you have to fill data into this structure.

 $league = {
    teams => {
	Yankees => {
	    players => {
		"Chien-Ming Wang" => {

lib/Baseball/Sabermetrics/abstract.pm  view on Meta::CPAN

package Baseball::Sabermetrics::abstract;
use strict;

our $AUTOLOAD;
our %formula;

#my $DEBUG = 0;

BEGIN {
    # formulas are weird, can we improve it ?
    %formula = (
	pa  =>		sub { $_->ab + $_->bb + $_->hbp + $_->sf },
	ta  =>		sub { $_->h + $_->{'2b'} + $_->{'3b'} * 2 + $_->hr * 3 },
	ba  =>		sub { $_->h / $_->ab },
	obp =>		sub { ($_->h + $_->bb + $_->hbp) / $_->pa },
	slg =>		sub { $_->tb / $_->ab },
	ops =>		sub { $_->obp + $_->slg },
	k_9 =>		sub { $_->p_so / $_->ip * 9 },
	bb_9 =>		sub { $_->p_bb / $_->ip * 9 },
	k_bb =>		sub { $_->p_so / $_->p_bb },
	isop =>		sub { $_->slg - $_->ba },

lib/Baseball/Sabermetrics/abstract.pm  view on Meta::CPAN

    if ($name eq 'DESTROY') {
	# is there a better way?
	$ref = \$name;
    }
    elsif (exists $self->{$name}) {
    	$ref = \$self->{$name};
    }
    elsif (exists $self->{$cachename}) {
    	$ref = \$self->{$cachename};
    }
    elsif (exists $formula{$name}) {
#	no strict;
#	use vars qw/ $team $league /;


	my $caller = caller;
	local $_ = $self;
#	local *league = exists $self->{league} ? \$self->{league} : undef;
#	local *team = exists $self->{team} ? \$self->{team} : undef;
#	$DEBUG && print STDERR "[",__PACKAGE__,"] calculating $self->{name}'s $name, league: $league, team: $team\n";

	unless (ref $formula{$name}) {
	    $formula{$name} =~ s[(\$?)(?<!->)("?)(\b\w(?:\w|->)*)][
		my ($d, $q, $n) = ($1, $2, $3);
		if ($q) {
		    "\"$n";
		}
		elsif ($n =~ /^\d+$/) {
		    $n;
		}
		# This is for 2b, 3b.  We assume that no formula has name with a digital initial.
		elsif ($n =~ /^\d/) {
		    "\$_->{'$n'}";
		}
		else {
		    $d ? "\$$n" : "\$_->$n"
		}
	    ]eg;
	    $formula{$name} =~ s/\$team/\$_->team/g;
	    $formula{$name} =~ s/\$league/\$_->league/g;
#	    print "## $name ##\n$formula{$name}\n";
	    $formula{$name} = eval "sub { $formula{$name} }" or die $@;
	}

	eval { $self->{$cachename} = $formula{$name}->(@_); };
    	die "$@ when eval  [ $name ] of $_->{name}\n" if $@;

	$ref = \$self->{$cachename};
    }
    else {
    	$ref = \$self->{$name};
    }

    $$ref;
}

lib/Baseball/Sabermetrics/abstract.pm  view on Meta::CPAN

	    print "$val\t";
	}
    }
    print "\n";
}

sub define
{
    my ($self, %funcs) = @_;
    %formula = (%formula, %funcs);
}

sub formula
{
    die "undefined formula" unless exists $formula{$_[1]};
    return $formula{$_[1]};
}

sub formula_list
{
    return keys %formula;
}

sub top
{
    my ($self, $what, $num, $func) = @_;
    if (! ref $func) {
	return (sort { $b->$func <=> $a->$func } $self->$what)[0..$num-1];
    }
    return (sort $func $self->what)[0..$num-1];
}