-- 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 ----------------------------------------------------