* 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 ***********************************************
times since October 20, 2004.