ADA Version, Listing




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

Return to Baseball Pennant Race Odds
Return to Harry's Home Page


This page accessed times since JOctober 20, 2004.
Page created by: hjsmithh@sbcglobal.net
Changes last made on Saturday, 14-May-05 12:42:42 PDT

1