-- Start of file BBallA.PKG --------------------------------------------------
with Text_IO, MathLib, Util, LongOps;
use Text_IO, MathLib, Util, LongOps;
procedure BBallA is
------------------------------------------------------------------------------
Name : constant String:=
"BBallA - Baseball probability (if each game is a 50-50 chance).";
Version : constant String:=
"ADA Version 2.04, last revised: 1993-09-27, 0600 hours";
Author : constant String:=
"Copyright (c) 1981-1993 by author: Harry J. Smith,";
Address : constant String:=
"19628 Via Monte Dr., Saratoga CA 95070. All rights reserved.";
------------------------------------------------------------------------------
-- program BBallA, Baseball probability
-- 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, converted to JANUS ADA
------------------------------------------------------------------------------
package Flo_IO is new Float_IO (Long_Float);
package Int_IO is new Integer_IO (Integer);
use Flo_IO, Int_IO;
ESC : constant Character:= Ascii.ESC;
TN1 : String(1..12); -- Team's name, 1st place team
TN2 : String(1..12); -- 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 : Long_Float; -- 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 : Long_Float; -- Probability that 1st place team beats 2nd place team
Q : Long_Float; -- Probability that 2nd place team beats 1st place team
Ch : Character; -- Character
St : String(1..131);-- Input string
J : Integer; -- Length of input string
Debug: Integer; -- /= 0 if debug turned on
procedure ReadInt( Mess : String; Min, Max, Nom : Integer;
I : in out Integer); -- Read in an integer from keyboard
procedure ReadReal( Mess : String; Min, Max, Nom : Long_Float;
R : in out Long_Float); -- Read in a Real from keyboard
---------------------------------------
procedure Init is -- Initialize program
begin
-- Ansi.Sys ESC seq. for YELLOW on BLUE, clrscr
Put( ESC); Put("[1;33;44m"); Put( ESC); Put("[2J");
New_Line;
Put_Line( Name);
Put_Line( Version);
Put_Line( Author);
Put_Line( Address);
New_Line;
end Init;
----------------------------------------
procedure GetCase is -- Get data for a case to compute
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); end if;
if I >= 0 then
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);
loop
ReadReal("Games ahead, 0, 0.5, ...", 0.0, 162.0, 0.0, GA);
exit when (Long_Float( INTEGER( GA + GA)) = (GA + GA));
end loop;
end if;
end GetCase;
----------------------------------------
procedure ExpandCase is -- Compute related data
I : Integer;
begin
GA2:= Integer( Round( 2.0 * GA));
I:= GL1 + GL2 - GA2;
if (I mod 2) = 1 then
Put_Line("Error in data");
Put_Line("Press Enter to continue..."); Get_Line( St, J);
end if;
MNT1:= I / 2; MNW1:= MNT1 + 1;
MNT2:= GL1 + GL2 - MNT1; MNW2:= MNT2 + 1;
end ExpandCase;
----------------------------------------
procedure DisplayCase is
begin
Put( GL1, 8); Put(" = Games Left to play, 1st place team ");
Put_Line( TN1);
Put( GL2, 8); Put(" = Games Left to play, 2nd place team ");
Put_Line( TN2);
Put( GE , 8); Put_Line(" = Games to play each other");
Put( GA , 6, 1, 0); Put_Line(
" = Games 1st place team is ahead. 0, 0.5, ...");
Put( MNT1, 8); Put_Line(" = Magic Number to tie for 1st place team");
Put( MNW1, 8); Put_Line(" = Magic Number to win for 1st place team");
Put( MNT2, 8); Put_Line(" = Magic Number to tie for 2nd place team");
Put( MNW2, 8); Put_Line(" = Magic Number to win for 2nd place team");
New_Line;
end DisplayCase;
----------------------------------------
procedure ComputeProb is -- Compute probability using a bivariate binomial
-- distribution as a model
I, J : Integer;
A, B : Long_Float;
E : array(0..24) of Long_Float; -- Binomial coefficients, games to play each
-- other
S : array(0..24) of Long_Float; -- Running sum of 2 * E(I)
F : array(0..162) of Long_Float; -- B. C., games not played with each other
G : array(0..162) of Long_Float; -- Sum of 2 * E(I) for 2nd place team win,
-- E(I) for tie
begin
A:= Long_Float( GL1 + GL2 - GE - GE); -- A = not played with each other games
B:= 1.0;
F(0):= 1.0;
for I in 1 .. MNT1 loop -- Compute binomial coefficients
F(I):= F(I - 1) * A / B;
A:= A - 1.0;
B:= B + 1.0;
end loop;
A:= Long_Float( GE);
B:= 1.0;
E(0):= 1.0;
S(0):= 2.0;
for I in 1 .. GE loop -- Compute binomial coefficients
E(I):= E(I - 1) * A / B;
A:= A - 1.0;
B:= B + 1.0;
S(I):= S(I - 1) + 2.0 * E(I);
end loop;
for I in 0 .. MNT1 loop -- Compute G(I)
J:= (MNT1 - I) / 2;
if J <= GE then
G(I):= S(J);
if (J + J) = (MNT1 - I) then G(I):= G(I) - E(J); --Adjust for tie
end if;
else
G(I):= S(GE);
end if;
end loop;
if Debug /= 0 then
DisplayCase;
for I in 0 .. MNT1 loop
Put("F("); Put(I, 1); Put(") = "); Put( F(I), 1, 0, 0); New_Line;
end loop;
New_Line;
Put_Line("Press Enter to continue..."); Get_Line( St, J);
for I in 0 .. GE loop
Put("E("); Put(I, 1); Put(") = "); Put( E(I), 1, 0, 0); New_Line;
end loop;
New_Line;
Put_Line("Press Enter to continue..."); Get_Line( St, J);
for I in 0 .. GE loop
Put("S("); Put(I, 1); Put(") = "); Put( S(I), 1, 0, 0); New_Line;
end loop;
New_Line;
Put_Line("Press Enter to continue..."); Get_Line( St, J);
for I in 0 .. MNT1 loop
Put("G("); Put(I, 1); Put(") = "); Put( G(I), 1, 0, 0); New_Line;
end loop;
New_Line;
Put_Line("Press Enter to continue..."); Get_Line( St, J);
end if; -- End Debug
Q:= 0.0;
for I in 0 .. MNT1 loop -- Compute probability that 2nd place team beats
Q:= Q + F(I) * G(I); -- 1st place team
end loop;
A:= Long_Float( GL1 + GL2 - GE + 1);
B:= 2.0 ** Integer(A); -- 2 ** Flips
Q:= Q / B;
P:= 1.0 - Q;
end ComputeProb;
----------------------------------------
procedure DisplayProb is -- Display probability
begin
Put(P, 5, 4, 0);
Put_Line(" = P = Probability that 1st place team beats 2nd place team");
Put(Q, 5, 4, 0);
Put_Line(" = Q = Probability that 2nd place team beats 1st place team");
if Q > 0.0 then
Put(1.0 / Q, 5, 4, 0);
Put(" = 1 / Q, (Odds = ");
Put(P / Q, 1, 4, 0);
Put_Line(" : 1)");
end if;
New_Line;
end DisplayProb;
----------------------------------------
procedure ReadInt( Mess : String; Min, Max, Nom : Integer;
I : in out Integer) is -- Read in an integer from keyboard
St : String(1..131);
J, K : Integer;
LF : Long_Float:= 0.0;
begin
loop
loop
Put_Line( Mess);
Put(" ["); Put( Min, 1); Put(", "); Put( Max, 1);
Put("] (ENTER => "); Put( Nom, 1); Put("): ");
Get_Line( St, J);
exit when J = 0;
St(J+1):= '.'; St(J+2):= '0'; St(J+3):= ' ';
begin -- Block to handle Data_Error exception
Get( St, LF, K);
exception
when Data_Error => K:= -1;
end;
exit when K >= 0;
end loop;
exit when ((LF >= Long_Float( Min)) and (LF <= Long_Float( Max)));
exit when J = 0;
end loop;
if J = 0 then LF:= Long_Float( Nom); end if;
I:= Integer( LF);
Put("Input = ");
Put(I, 1); New_Line;
New_Line;
end ReadInt;
----------------------------------------
procedure ReadReal( Mess : String; Min, Max, Nom : Long_Float;
R : in out Long_Float) is -- Read in a Real from keyboard
St : String(1..131);
J, K : Integer;
begin
loop
loop
Put_Line( Mess);
Put(" ["); Put( Min, 1, 1, 0); Put(", "); Put( Max, 1, 1, 0);
Put("] (ENTER => "); Put( Nom, 1, 1, 0); Put("): ");
Get_Line( St, J);
exit when J = 0;
St(J+1):= '.'; St(J+2):= '0'; St(J+3):= ' ';
begin -- Block to handle Data_Error exception
Get( St, R, K);
exception
when Data_Error => K:= -1;
end;
exit when K >= 0;
end loop;
exit when ((R >= Min) and (R <= Max)) or (J = 0);
end loop;
if J = 0 then R:= Nom; end if;
Put("Input = ");
Put(R, 1, 1, 0); New_Line;
New_Line;
end ReadReal;
----------------------------------------
begin -- Main program, BBallA
Debug:= 0;
loop
Init;
GetCase;
ExpandCase;
ComputeProb;
Init;
DisplayCase;
DisplayProb;
Put_Line("Press Enter to continue... (or Ctrl-C to exit)");
Get_Line( St, J);
end loop;
Halt(0);
end BBallA;
-- End of file BBallA.PKG ----------------------------------------------------
times since JOctober 20, 2004.