-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathsplits.pl
executable file
·118 lines (97 loc) · 4.18 KB
/
splits.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
#!/usr/bin/perl -wT
# $Id: splits.pl,v 1.4 2011/02/09 18:00:04 sweda Exp sweda $
# split regression tool
use strict;
use CGI;
# use CGI::Pretty;
$CGI::POST_MAX=1024 * 100; # max 100K posts
$CGI::DISABLE_UPLOADS = 1; # no uploads
use List::Util qw[min max sum];
sub regrate {
my $pa = shift;
if ( $pa > 750 ) {
return( 0 );
} elsif ( $pa > 24 ) {
return ( .75 - .75 / 750 * $pa );
} else {
return ( 1.00 - 0.01 * $pa );
}
}
sub simplereg {
my $lh = $_[0] / $_[1];
my $rh = $_[2] / $_[3];
my $ltarget = ( $lh + $rh ) / 2;
my $rtarget = $ltarget;
my $regpa = min( $_[1], $_[3] );
my $lrate = ( $lh - ( regrate( $regpa ) * ( $lh - $ltarget ) ) * $_[3] / ( $_[1] + $_[3] ) * 2 );
my $rrate = ( $rh - ( regrate( $regpa ) * ( $rh - $rtarget ) ) * $_[1] / ( $_[1] + $_[3] ) * 2 );
$_[0] = $lrate * $_[1];
$_[2] = $rrate * $_[3];
}
my $q = new CGI;
print $q->header, $q->start_html( 'splits.pl' );
print $q->p, "input split data";
print $q->start_form( 'POST', '/~sweda/cgi-bin/splits.pl' );
print $q->p, "vs LH\t";
print $q->textfield( 'abL','AB',3,3);
print $q->textfield( 'hL','H',3,3);
print $q->textfield( 'dL','2B',3,3);
print $q->textfield( 'tL','3B',3,3);
print $q->textfield( 'hrL','HR',3,3);
print $q->textfield( 'bbL','BB',3,3);
print $q->textfield( 'hbL','HB',3,3);
print $q->p, "vs RH\t";
print $q->textfield( 'abR','AB',3,3);
print $q->textfield( 'hR','H',3,3);
print $q->textfield( 'dR','2B',3,3);
print $q->textfield( 'tR','3B',3,3);
print $q->textfield( 'hrR','HR',3,3);
print $q->textfield( 'bbR','BB',3,3);
print $q->textfield( 'hbR','HB',3,3);
print $q->p, $q->submit, $q->end_form;
# validate input
my $var;
foreach $var ( $q->param ) {
if ( $q->param( $var ) !~ /^\d+$/ ) {
goto EXIT;
}
}
if ( ! defined $q->param( 'abL' ) || ! defined $q->param( 'abR' ) ) {
goto EXIT;
}
$q->import_names('F');
if ( $F::abL > 0 && $F::abR > 0 ) {
print "<pre>";
print "original data\n";
printf " AB H 1B 2B 3B HR BB HB BA OBP SLG\n", $F::abL, $F::hL, $F::dL, $F::tL, $F::hrL, $F::bbL, $F::hbL;
printf "vLH %3d %3d %3d %3d %3d %3d %3d %3d ", $F::abL, $F::hL, $F::hL - $F::dL - $F::tL - $F::hrL, $F::dL, $F::tL, $F::hrL, $F::bbL, $F::hbL;
printf " %5.3f", $F::hL / $F::abL;
printf " %5.3f", ( $F::hL + $F::bbL + $F::hbL ) / ( $F::abL + $F::bbL + $F::hbL );
printf " %5.3f\n", ( $F::hL + $F::dL + 2 * $F::tL + 3 * $F::hrL ) / $F::abL;
printf "vRH %3d %3d %3d %3d %3d %3d %3d %3d ", $F::abR, $F::hR, $F::hR - $F::dR - $F::tR - $F::hrR, $F::dR, $F::tR, $F::hrR, $F::bbR, $F::hbR;
printf " %5.3f", $F::hR / $F::abR;
printf " %5.3f", ( $F::hR + $F::bbR + $F::hbR ) / ( $F::abR + $F::bbR + $F::hbR );
printf " %5.3f\n", ( $F::hR + $F::dR + 2 * $F::tR + 3 * $F::hrR ) / $F::abR;
print $q->p;
my @lh = ( $F::abL + $F::bbL + $F::hbL, $F::hL - $F::dL - $F::tL - $F::hrL, $F::dL, $F::tL, $F::hrL, $F::bbL, $F::hbL );
my @rh = ( $F::abR + $F::bbR + $F::hbR, $F::hR - $F::dR - $F::tR - $F::hrR, $F::dR, $F::tR, $F::hrR, $F::bbR, $F::hbR );
for ( my $i = 1; $i < 7; $i++ ) {
#print "orig: $lh[$i] $rh[$i]\n";
simplereg( $lh[$i], $lh[0], $rh[$i], $rh[0] );
#print "new: $lh[$i] $rh[$i]\n";
}
print "simple split regression\n";
printf " AB 1B 2B 3B HR BB HB BA OBP SLG\n", $F::abL, $F::hL, $F::dL, $F::tL, $F::hrL, $F::bbL, $F::hbL;
printf "vLH %5.1f %5.1f %5.1f %5.1f %5.1f %5.1f %5.1f ", $F::abL, $lh[1], $lh[2], $lh[3], $lh[4], $lh[5], $lh[6];
printf " %5.3f", ( $lh[1] + $lh[2] + $lh[3] + $lh[4] ) / $F::abL;
printf " %5.3f", ( $lh[1] + $lh[2] + $lh[3] + $lh[4] + $lh[5] + $lh[6] ) / ( $F::abL + $lh[5] + $lh[6] );
printf " %5.3f\n", ( $lh[1] + 2 * $lh[2] + 3 * $lh[3] + 4 * $lh[4] ) / $F::abL;
printf "vRH %5.1f %5.1f %5.1f %5.1f %5.1f %5.1f %5.1f ", $F::abR, $rh[1], $rh[2], $rh[3], $rh[4], $rh[5], $rh[6];
printf " %5.3f", ( $rh[1] + $rh[2] + $rh[3] + $rh[4] ) / $F::abR;
printf " %5.3f", ( $rh[1] + $rh[2] + $rh[3] + $rh[4] + $rh[5] + $rh[6] ) / ( $F::abR + $rh[5] + $rh[6] );
printf " %5.3f\n", ( $rh[1] + 2 * $rh[2] + 3 * $rh[3] + 4 * $rh[4] ) / $F::abR;
print $q->p;
print "</pre>";
}
EXIT:
print $q->end_html;