{Start of file BBallP.Pas **************************************************}
{$I-} {do our own i/o error checks}
{$N+} {Uses numeric coprocessor}
{$R+} {index Range checking}
{$DEFINE Debug}
{$UNDEF Debug}
program BBallP; {Baseball probability}
uses
Printer, Crt; {Turbo Pascal 5.0 interface}
const
Name = 'BBallP - Baseball probability (if each game is a 50-50 chance).';
Version = 'Pascal Version 2.03, last revised: 1993-09-27, 0600 hours';
Author = 'Copyright (c) 1981-1993 by author: Harry J. Smith,';
Address = '19628 Via Monte Dr., Saratoga CA 95070. All rights reserved.';
{***************************************************************************}
{Computes the probability that the 1st place team will beat the 2nd place}
{team for the division title, assuming each has a 50-50 chance of winning}
{any given future game. Uses a bivariate binomial distribution as a model.}
{Developed in Turbo Pascal 5.0}
const ESC = Chr( 27);
var
TN1 : String[10]; {Team's name, 1st place team}
TN2 : String[10]; {Team's name, 2nd place team}
GL1 : Integer; {Games Left to play, 1st place team}
GL2 : Integer; {Games Left to play, 2nd place team}
GE : Integer; {Games to play each other}
GA : Double; {Games 1st place team is ahead. 0, 0.5, ...}
GA2 : Integer; {Twice games ahead = 2 * GA, 0, 1, ...}
MNT1 : Integer; {Magic Number to tie for 1st place team}
MNW1 : Integer; {Magic Number to win for 1st place team}
MNT2 : Integer; {Magic Number to tie for 2nd place team}
MNW2 : Integer; {Magic Number to win for 2nd place team}
P : Double; {Probability that 1st place team beats 2nd place team}
Q : Double; {Probability that 2nd place team beats 1st place team}
Ch : Char;
procedure ReadInt( Mess : String; Min, Max, Nom : Integer;
var I : Integer); forward; {Read in an integer from keyboard}
procedure ReadReal( Mess : String; Min, Max, Nom : Double;
var R : Double); forward; {Read in a Real from keyboard}
{--------------------------------------}
procedure Init; {Initialize program}
begin
TextBackground( Blue);
TextColor( Yellow);
ClrScr;
WriteLn;
WriteLn( Name);
WriteLn( Version);
WriteLn( Author);
WriteLn( Address);
WriteLn;
end; {Init}
{--------------------------------------}
procedure GetCase; {Get data for a case to compute}
var
I : Integer;
begin
{ Giants, Braves 1993}
TN1:= 'Braves'; TN2:= 'Giants';
GL1:= 6; GL2:= 7; GE:= 0; GA:= 1.5; { 1993-09-27, 1 / Q = 4.7175}
ReadInt('Games Left to play, 1st place team (-2 => Exit, -1 => Test case)',
-2, 162, -1, I);
if I = -2 then Halt(0);
if I >= 0 then begin
TN1:= ' '; TN2:= ' ';
GL1:= I;
ReadInt('Games Left to play, 2nd place team', 0, 162, GL1, GL2);
ReadInt('Games to play each other', 0, 24, 0, GE);
repeat
ReadReal('Games ahead, 0, 0.5, ...', 0, 162, 0, GA);
until (Frac( GA + GA) = 0);
end;
end; {GetCase}
{--------------------------------------}
procedure ExpandCase; {Compute related data}
var
I : Integer;
begin
GA2:= Round(2 * GA);
I:= GL1 + GL2 - GA2;
if Odd(I) then begin
WriteLn('Error in data');
WriteLn('Press any key to continue...'); Ch:= ReadKey;
end;
MNT1:= I div 2; MNW1:= MNT1 + 1;
MNT2:= GL1 + GL2 - MNT1; MNW2:= MNT2 + 1;
end; {ExpandCase}
{--------------------------------------}
procedure DisplayCase;
begin
WriteLn( GL1:8, ' = Games Left to play, 1st place team (', TN1, ')');
WriteLn( GL2:8, ' = Games Left to play, 2nd place team (', TN2, ')');
WriteLn( GE :8, ' = Games to play each other');
WriteLn( GA :8:1,' = Games 1st place team is ahead. 0, 0.5, ...');
WriteLn( MNT1:8, ' = Magic Number to tie for 1st place team');
WriteLn( MNW1:8, ' = Magic Number to win for 1st place team');
WriteLn( MNT2:8, ' = Magic Number to tie for 2nd place team');
WriteLn( MNW2:8, ' = Magic Number to win for 2nd place team');
WriteLn;
end; {DisplayCase}
{--------------------------------------}
procedure ComputeProb; {Compute probability using a bivariate binomial
distribution as a model}
var
I, J : Integer;
A, B : Double;
E : Array[0..24] of Double; {Binomial coefficients, games to play each other}
S : Array[0..24] of Double; {Running sum of 2 * E[I]}
F : Array[0..162] of Double; {B. C., games not played with each other}
G : Array[0..162] of Double; {Sum of 2 * E[I] for 2nd place team win,}
{ E[I] for tie}
begin
A:= GL1 + GL2 - GE - GE; {A = not played with each other games}
B:= 1.0;
F[0]:= 1.0;
for I:= 1 to MNT1 do begin {Compute binomial coefficients}
F[I]:= F[I - 1] * A / B;
A:= A - 1.0;
B:= B + 1.0;
end;
A:= GE;
B:= 1.0;
E[0]:= 1.0;
S[0]:= 2.0;
for I:= 1 to GE do begin {Compute binomial coefficients}
E[I]:= E[I - 1] * A / B;
A:= A - 1.0;
B:= B + 1.0;
S[I]:= S[I - 1] + 2 * E[I];
end;
for I:= 0 to MNT1 do begin {Compute G[I]}
J:= (MNT1 - I) div 2;
if J <= GE then begin
G[I]:= S[J];
if (J + J) = (MNT1 - I) then G[I]:= G[I] - E[J]; {Adjust for tie}
end
else
G[I]:= S[GE];
end;
{$IFDEF Debug}
DisplayCase;
for I:= 0 to MNT do begin
WriteLn('F[', I, '] = ', F[I]:0:0);
end;
WriteLn;
WriteLn('Press any key to continue...'); Ch:= ReadKey;
WriteLn;
for I:= 0 to GE do begin
WriteLn('E[', I, '] = ', E[I]:0:0);
end;
WriteLn;
WriteLn('Press any key to continue...'); Ch:= ReadKey;
WriteLn;
for I:= 0 to GE do begin
WriteLn('S[', I, '] = ', S[I]:0:0);
end;
WriteLn;
WriteLn('Press any key to continue...'); Ch:= ReadKey;
WriteLn;
for I:= 0 to MNT do begin
WriteLn('G[', I, '] = ', G[I]:0:0);
end;
WriteLn;
WriteLn('Press any key to continue...'); Ch:= ReadKey;
WriteLn;
{$ENDIF}
Q:= 0.0;
for I:= 0 to MNT1 do begin {Compute probability that 2nd place team beats}
{ 1st place team}
Q:= Q + F[I] * G[I];
end;
A:= GL1 + GL2 - GE + 1;
B:= Exp(A * Ln( 2.0)); {2 ** Flips}
Q:= Q / B;
P:= 1.0 - Q;
end; {ComputeProb}
{--------------------------------------}
procedure DisplayProb; {Display probability}
begin
WriteLn( P:10:4,
' = P = Probability that 1st place team beats 2nd place team');
WriteLn( Q:10:4,
' = Q = Probability that 2nd place team beats 1st place team');
if Q > 0.0 then
WriteLn(1.0 / Q:10:4, ' = 1 / Q, (Odds = ', P / Q:1:4, ' : 1)');
WriteLn;
end; {DisplayProb}
{--------------------------------------}
procedure ReadInt( Mess : String; Min, Max, Nom : Integer;
var I : Integer); {Read in an integer from keyboard}
var
St : String[ 255];
Stat : Integer;
LI : LongInt;
begin
repeat
repeat
WriteLn( Mess);
Write(' [', Min, ', ', Max, '] (ENTER => ', Nom, '): ');
ReadLn( St);
until IOResult = 0;
Val( St, LI, Stat);
until ((Stat = 0) and (LI >= Min) and (LI <= Max)) or (Length( St) = 0);
if Length( St) = 0 then LI:= Nom;
I:= LI;
WriteLn('Input = ', I);
WriteLn;
end; {ReadInt}
{--------------------------------------}
procedure ReadReal( Mess : String; Min, Max, Nom : Double;
var R : Double); {Read in a Real from keyboard}
var
St : String[ 255];
Stat : Integer;
begin
repeat
repeat
WriteLn(Mess);
Write(' [', Min:0:1, ', ', Max:0:1, '] (ENTER => ', Nom:0:1, '): ');
ReadLn(St);
until IOResult = 0;
Val(St, R, Stat);
until ((Stat = 0) and (R >= Min) and (R <= Max)) or (Length(St) = 0);
if Length(St) = 0 then R:= Nom;
WriteLn('Input = ', R:0:1);
WriteLn;
end; {ReadReal}
{--------------------------------------}
begin {Main program, BBallP}
repeat
Init;
GetCase;
ExpandCase;
ComputeProb;
Init;
DisplayCase;
DisplayProb;
WriteLn('Press any key to continue... (or ESC to exit)'); Ch:= ReadKey;
until Ch = ESC;
Halt(0);
end. {BBallP}
{End of file BBallP.Pas ****************************************************}
times since October 20, 2004.