* Start of file BBallF.FOR ********************************************* * ---------------------------------------------------------------------- * PROGRAM: BBallF - Baseball probability * ---------------------------------------------------------------------- * BBallF - Baseball probability (if each game is a 50-50 chance). * FORTRAN Version 2.03, last revised: 1993-09-27, 0600 hours * Copyright (c) 1981-1993 by author: Harry J. Smith, * 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, converted to MS FORTRAN * * ---------------------------------------------------------------------- $STORAGE:2 INTERFACE TO SUBROUTINE ReadInt( Mess, Min, Max, Nom, I) CHARACTER*(*) Mess INTEGER*2 Min, Max, Nom, I END * ---------------------------------------------------------------------- INTERFACE TO SUBROUTINE ReadReal( Mess, Min, Max, Nom, R) CHARACTER*(*) Mess DOUBLE PRECISION Min, Max, Nom, R END * ---------------------------------------------------------------------- CHARACTER Name*70, Version*70, Author*70, Address*70 CHARACTER TN1*12, TN2*12 INTEGER*2 GL1, GL2, GE, GA2, MNT1, MNW1, MNT2, MNW2, Debug DOUBLE PRECISION GA, P, Q INTEGER*1 Ch COMMON Name, Version, Author, Address COMMON /NUM/ TN1, TN2, GL1, GL2, GE, GA2, MNT1, MNW1, MNT2, # MNW2, GA, P, Q, Ch, Debug * ---------------------------------------------------------------------- * TN1 : Team's name, 1st place team * TN2 : Team's name, 2nd place team * GL1 : Games Left to play, 1st place team * GL2 : Games Left to play, 2nd place team * GE : Games to play each other * GA : Games 1st place team is ahead. 0, 0.5, ... * GA2 : Twice games ahead = 2 * GA, 0, 1, ... * MNT1 : Magic Number to tie for 1st place team * MNW1 : Magic Number to win for 1st place team * MNT2 : Magic Number to tie for 2nd place team * MNW2 : Magic Number to win for 2nd place team * P : Probability that 1st place team beats 2nd place team * Q : Probability that 2nd place team beats 1st place team * Ch : A keyboard input character * Debug: .NE. 0 if debug turned on * ---------------------------------------------------------------------- Name = #'BBallF - Baseball probability (if each game is a 50-50 chance).' Version = #'FORTRAN 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.' * ---------------------------------------------------------------------- * Main program, BBallF Debug = 0 100 CALL Init() CALL GetCase() CALL ExpandCase() CALL ComputeProb() CALL Init() CALL DispCase() CALL DispProb() WRITE(*, 10) 'Press Enter to continue... (or Ctrl-C to exit)' READ(*, 10) Ch GOTO 100 10 FORMAT( 1X, A) END * ---------------------------------------------------------------------- * SUBROUTINE: Init - Initialize the program BBallF * ---------------------------------------------------------------------- SUBROUTINE Init() CHARACTER Name*70, Version*70, Author*70, Address*70 COMMON Name, Version, Author, Address * ---------------------------------------------------------------------- WRITE(*, 10) WRITE(*, 11) Name WRITE(*, 11) Version WRITE(*, 11) Author WRITE(*, 11) Address WRITE(*, 12) * Ansi.Sys ESC seq. for YELLOW on BLUE, clrscr 10 FORMAT(' [1;33;44m [2J') 11 FORMAT( 1X, A) 12 FORMAT() END * ---------------------------------------------------------------------- * SUBROUTINE: GetCase - Get data for a case to compute * ---------------------------------------------------------------------- SUBROUTINE GetCase() CHARACTER TN1*12, TN2*12 INTEGER*2 GL1, GL2, GE, GA2, MNT1, MNW1, MNT2, MNW2, Debug DOUBLE PRECISION GA, P, Q INTEGER*1 Ch COMMON /NUM/ TN1, TN2, GL1, GL2, GE, GA2, MNT1, MNW1, MNT2, # MNW2, GA, P, Q, Ch, Debug INTEGER*2 I * ---------------------------------------------------------------------- * Giants, Braves 1993 * 1993-09-27, 1 / Q = 4.7175 TN1 = '(Braves)' TN2 = '(Giants)' GL1 = 6 GL2 = 7 GE = 0 GA = 1.5 CALL ReadInt( #'Games Left to play, 1st place team (-2 => Exit, -1 => Test case)' #, -2, 162, -1, I) IF (I .EQ. -2) STOP ' ' IF (I .GE. 0) THEN TN1 = '( )' TN2 = '( )' GL1 = I CALL ReadInt('Games Left to play, 2nd place team', # 0, 162, GL1, GL2) CALL ReadInt('Games to play each other', 0, 24, 0, GE) 100 CONTINUE CALL ReadReal('Games ahead, 0, 0.5, ...', # 0.0D0, 162.0D0, 0.0D0, GA) IF (DINT( GA + GA) .NE. (GA + GA)) GOTO 100 ENDIF END * ---------------------------------------------------------------------- * SUBROUTINE: ExpandCase - Compute related data * ---------------------------------------------------------------------- SUBROUTINE ExpandCase() CHARACTER TN1*12, TN2*12 INTEGER*2 GL1, GL2, GE, GA2, MNT1, MNW1, MNT2, MNW2, Debug DOUBLE PRECISION GA, P, Q INTEGER*1 Ch COMMON /NUM/ TN1, TN2, GL1, GL2, GE, GA2, MNT1, MNW1, MNT2, # MNW2, GA, P, Q, Ch, Debug INTEGER*2 I * ---------------------------------------------------------------------- GA2 = IDNINT(2 * GA) I = GL1 + GL2 - GA2 IF (MOD(I, 2) .EQ. 1) THEN WRITE(*, 10) WRITE(*, 20) READ(*, 30) Ch ENDIF MNT1 = I / 2 MNW1 = MNT1 + 1 MNT2 = GL1 + GL2 - MNT1 MNW2 = MNT2 + 1 10 FORMAT(' Error in data') 20 FORMAT(' Press Enter to continue...'\) 30 FORMAT( 1X, A) END * ---------------------------------------------------------------------- * SUBROUTINE: DispCase - Display Case * ---------------------------------------------------------------------- SUBROUTINE DispCase() CHARACTER TN1*12, TN2*12 INTEGER*2 GL1, GL2, GE, GA2, MNT1, MNW1, MNT2, MNW2, Debug DOUBLE PRECISION GA, P, Q INTEGER*1 Ch COMMON /NUM/ TN1, TN2, GL1, GL2, GE, GA2, MNT1, MNW1, MNT2, # MNW2, GA, P, Q, Ch, Debug * ---------------------------------------------------------------------- WRITE(*, 10) GL1, TN1 WRITE(*, 20) GL2, TN2 WRITE(*, 30) GE WRITE(*, 40) GA WRITE(*, 50) MNT1 WRITE(*, 60) MNW1 WRITE(*, 70) MNT2 WRITE(*, 80) MNW2 WRITE(*, 90) 10 FORMAT(' ', I8, # ' = Games Left to play, 1st place team ', A) 20 FORMAT(' ', I8, # ' = Games Left to play, 2nd place team ', A) 30 FORMAT(' ', I8, ' = Games to play each other') 40 FORMAT(' ', F8.1, # ' = Games 1st place team is ahead. 0, 0.5, ...') 50 FORMAT(' ', I8, ' = Magic Number to tie for 1st place team') 60 FORMAT(' ', I8, ' = Magic Number to win for 1st place team') 70 FORMAT(' ', I8, ' = Magic Number to tie for 2nd place team') 80 FORMAT(' ', I8, ' = Magic Number to win for 2nd place team') 90 FORMAT() END * ---------------------------------------------------------------------- * SUBROUTINE: ComputeProb - Compute probability using a bivariate * binomial distribution as a model * ---------------------------------------------------------------------- SUBROUTINE ComputeProb() CHARACTER TN1*12, TN2*12 INTEGER*2 GL1, GL2, GE, GA2, MNT1, MNW1, MNT2, MNW2, Debug DOUBLE PRECISION GA, P, Q INTEGER*1 Ch COMMON /NUM/ TN1, TN2, GL1, GL2, GE, GA2, MNT1, MNW1, MNT2, # MNW2, GA, P, Q, Ch, Debug INTEGER*2 I, J DOUBLE PRECISION A, B DOUBLE PRECISION E (0:24), S (0:24), F (0:162), G (0:162) * E: Binomial coefficients, games to play each other * S: Running sum of 2 * E(I) * F: Binomial coefficients, games not played with each other * G: Sum of 2 * E(I) for 2nd place team win, E(I) for tie * A: Games not played with each other * ---------------------------------------------------------------------- A = GL1 + GL2 - GE - GE B = 1.0 F(0) = 1.0 * Compute binomial coefficients DO 100 I = 1, MNT1 F(I) = F(I - 1) * A / B A = A - 1.0 B = B + 1.0 100 CONTINUE A = GE B = 1.0 E(0) = 1.0 S(0) = 2.0 * Compute binomial coefficients DO 110 I = 1, GE E(I) = E(I - 1) * A / B A = A - 1.0 B = B + 1.0 S(I) = S(I - 1) + 2 * E(I) 110 CONTINUE * Compute G(I) DO 120 I = 0, MNT1 J = (MNT1 - I) / 2 IF (J .LE. GE) THEN G(I) = S(J) * Adjust for tie IF ((J + J) .EQ. (MNT1 - I)) THEN G(I) = G(I) - E(J) ENDIF ELSE G(I) = S(GE) ENDIF 120 CONTINUE IF (Debug .NE. 0) THEN CALL DispCase() DO 122 I = 0, MNT1 WRITE(*, 20) I, F(I) 122 CONTINUE WRITE(*, 11) WRITE(*, 10) 'Press Enter to continue...' READ(*, 10) Ch WRITE(*, 11) DO 124 I = 0, GE WRITE(*, 30) I, E(I) 124 CONTINUE WRITE(*, 11) WRITE(*, 10) 'Press Enter to continue...' READ(*, 10) Ch WRITE(*, 11) DO 126 I = 0, GE WRITE(*, 40) I, S(I) 126 CONTINUE WRITE(*, 11) WRITE(*, 10) 'Press Enter to continue...' READ(*, 10) Ch WRITE(*, 11) DO 128 I = 0, MNT1 WRITE(*, 50) I, G(I) 128 CONTINUE WRITE(*, 11) WRITE(*, 10) 'Press Enter to continue...' READ(*, 10) Ch WRITE(*, 11) 10 FORMAT( 1X, A\) 11 FORMAT() 20 FORMAT(' F(', I3, ') = ', G22.17) 30 FORMAT(' E(', I3, ') = ', G22.17) 40 FORMAT(' S(', I3, ') = ', G22.17) 50 FORMAT(' G(', I3, ') = ', G22.17) * End of Debug ENDIF Q = 0.0 * Compute probability that 2nd place team beats 1st place team DO 130 I = 0, MNT1 Q = Q +F(I) * G(I) 130 CONTINUE A = GL1 + GL2 - GE + 1 * 2 ** Flips B = 2.0 ** A Q = Q / B P = 1.0 - Q END * ---------------------------------------------------------------------- * SUBROUTINE: DispProb - Display probability * ---------------------------------------------------------------------- SUBROUTINE DispProb() CHARACTER TN1*12, TN2*12 INTEGER*2 GL1, GL2, GE, GA2, MNT1, MNW1, MNT2, MNW2, Debug DOUBLE PRECISION GA, P, Q INTEGER*1 Ch COMMON /NUM/ TN1, TN2, GL1, GL2, GE, GA2, MNT1, MNW1, MNT2, # MNW2, GA, P, Q, Ch, Debug * ---------------------------------------------------------------------- WRITE(*, 10) P WRITE(*, 20) Q IF (Q .GT. 0.0) # WRITE(*, 30) 1.0 / Q, P / Q WRITE(*, 40) 10 FORMAT(' ', F10.4, # ' = P = Probability that 1st place team beats 2nd place team') 20 FORMAT(' ', F10.4, # ' = Q = Probability that 2nd place team beats 1st place team') 30 FORMAT # (' ', F10.4, ' = 1 / Q, (Odds = ', F10.4, ' : 1)') 40 FORMAT() END * ---------------------------------------------------------------------- * SUBROUTINE: ReadInt - Read in an integer from keyboard * AUTHOR: HARRY J. SMITH, SARATOGA, CA * ---------------------------------------------------------------------- * * ---------------------------------------------------------------------- * This is the FORTRAN subroutine ReadInt to read an integer from the * keyboard * ---------------------------------------------------------------------- SUBROUTINE ReadInt( Mess, Min, Max, Nom, I) CHARACTER*(*) Mess INTEGER*2 Min, Max, Nom, I CHARACTER*255 St INTEGER*4 LI * ---------------------------------------------------------------------- 100 WRITE(*, 10) Mess WRITE(*, 20) Min, Max, Nom READ(*, 30) St IF ((St .NE. ' ') .AND. (St(1:1) .NE. '-') .AND. # (LGT( St(1:1), '9') .OR. LLT( St(1:1), '0'))) GOTO 100 READ( St, 40) LI IF (((LI .LT. Min) .OR. (LI .GT. Max)) .AND. (St .NE. ' ')) # GOTO 100 IF (St .EQ. ' ') LI = Nom I = LI WRITE(*, 50) I WRITE(*, 11) 10 FORMAT( 1X, A) 11 FORMAT() 20 FORMAT(' [', I3, ', ', I3, '] (ENTER => ', I3, '): '\) 30 FORMAT( A129) 40 FORMAT( I10) 50 FORMAT(' Input = ', I3) END * ---------------------------------------------------------------------- * SUBROUTINE: ReadReal - Read in a Real from keyboard * AUTHOR: HARRY J. SMITH, SARATOGA, CA * ---------------------------------------------------------------------- * * ---------------------------------------------------------------------- * This is the FORTRAN subroutine ReadReal to read a real number from the * keyboard * ---------------------------------------------------------------------- SUBROUTINE ReadReal( Mess, Min, Max, Nom, R) CHARACTER*(*) Mess DOUBLE PRECISION Min, Max, Nom, R CHARACTER*255 St * ---------------------------------------------------------------------- 100 WRITE(*, 10) Mess WRITE(*, 20) Min, Max, Nom READ(*, 30) St IF ((St .NE. ' ') .AND. (St(1:1) .NE. '-') .AND. # (LGT( St(1:1), '9') .OR. LLT( St(1:1), '0'))) GOTO 100 READ( St, 40) R IF (((R .LT. Min) .OR. (LI .GT. Max)) .AND. (St .NE. ' ')) # GOTO 100 IF (St .EQ. ' ') R = Nom WRITE(*, 50) R WRITE(*, 11) 10 FORMAT( 1X, A) 11 FORMAT() 20 FORMAT(' [', F5.1, ', ', F5.1, '] (ENTER => ', F5.1, '): '\) 30 FORMAT( A129) 40 FORMAT( F10.0) 50 FORMAT(' Input = ', F5.1) END * End of file BBallF.FOR ***********************************************