Pascal Version, Listing

{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 ****************************************************}