QBASIC Version, Listing

'Start of file BBallQ.Bas **************************************************

DECLARE SUB ReadInt (Mess AS STRING, Min AS INTEGER, Max AS INTEGER, Nom AS INTEGER, I AS INTEGER)
  'Read in an integer
DECLARE SUB ReadReal (Mess AS STRING, Min AS DOUBLE, Max AS DOUBLE, Nom AS DOUBLE, R AS DOUBLE)
  'Read in a Real number

  Name$ = "BBallQ - Baseball probability (if each game is a 50-50 chance)."
  Version$ = "QuickBASIC 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, converted to QuickBASIC 4.5

'Global variables:
ESC$ = CHR$(27)
DIM TN1  AS STRING  'Team's name, 1st place team
DIM TN2  AS STRING  'Team's name, 2nd place team
DIM GL1  AS INTEGER 'Games Left to play, 1st place team
DIM GL2  AS INTEGER 'Games Left to play, 2nd place team
DIM GE   AS INTEGER 'Games to play each other
DIM GA   AS DOUBLE  'Games 1st place team is ahead. 0, 0.5, ...
DIM GA2  AS INTEGER 'Twice games ahead = 2 * GA, 0, 1, ...
DIM MNT1 AS INTEGER 'Magic Number to tie for 1st place team
DIM MNW1 AS INTEGER 'Magic Number to win for 1st place team
DIM MNT2 AS INTEGER 'Magic Number to tie for 2nd place team
DIM MNW2 AS INTEGER 'Magic Number to win for 2nd place team
DIM P    AS DOUBLE  'Probability that 1st place team beats 2nd place team
DIM Q    AS DOUBLE  'Probability that 2nd place team beats 1st place team
DIM Ch$(1)          'Character
DIM Debug AS INTEGER '<> 0 if debug turned on
                       
'--------------------------------------
'Main program, BBallQ
  Debug = 0
  DO
    GOSUB Init
    GOSUB GetCase
    GOSUB ExpandCase
    GOSUB ComputeProb
    GOSUB Init
    GOSUB DisplayCase
    GOSUB DisplayProb
    PRINT "Press any key to continue... (or ESC to exit)";
    Ch$ = INPUT$(1)
  LOOP UNTIL Ch$ = ESC$
  END
'End Main program, BBallQ

'--------------------------------------
Init: 'Initialize program
  COLOR 14, 1 'Yellow on Blue
  CLS
  PRINT
  PRINT Name$
  PRINT Version$
  PRINT Author$
  PRINT Address$
  PRINT
RETURN 'Init

'--------------------------------------
GetCase: 'Get data for a case to compute
  DIM I AS INTEGER

' Giants, Braves 1993
  TN1 = "Braves": TN2 = "Giants"
  GL1 = 6: GL2 = 7: GE = 0: GA = 1.5 '1993-09-27, 1 / Q = 4.7175
  St$ = "Games Left to play, 1st place team (-2 => Exit, -1 => Test case)"
  CALL ReadInt(St$, -2, 162, -1, I)
  IF I = -2 THEN END
  IF I >= 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)
    DO
      CALL ReadReal("Games ahead, 0, 0.5, ...", 0, 162#, 0, GA)
    LOOP UNTIL (INT(GA + GA) = GA + GA)
  END IF
RETURN 'GetCase

'--------------------------------------
ExpandCase: 'Compute related data
  GA2 = CINT(2 * GA) 'Round
  I = GL1 + GL2 - GA2
  IF (I MOD 2 = 1) THEN 'if I is odd
    PRINT "Error in data"
    PRINT "Press any key to continue...": Ch$ = INPUT$(1)
  END IF
  MNT1 = INT(I / 2): MNW1 = MNT1 + 1
  MNT2 = GL1 + GL2 - MNT1: MNW2 = MNT2 + 1
RETURN 'ExpandCase

'--------------------------------------
DisplayCase:
  PRINT USING "########"; GL1;
  PRINT " = Games Left to play, 1st place team ("; TN1; ")"
  PRINT USING "########"; GL2;
  PRINT " = Games Left to play, 2nd place team ("; TN2; ")"
  PRINT USING "########"; GE; : PRINT " = Games to play each other"
  PRINT USING "######.#"; GA; : PRINT " = Games 1st place team is ahead.  0, 0.5, ..."
  PRINT USING "########"; MNT1; : PRINT " = Magic Number to tie for 1st place team"
  PRINT USING "########"; MNW1; : PRINT " = Magic Number to win for 1st place team"
  PRINT USING "########"; MNT2; : PRINT " = Magic Number to tie for 2nd place team"
  PRINT USING "########"; MNW2; : PRINT " = Magic Number to win for 2nd place team"
  PRINT
RETURN 'DisplayCase

'--------------------------------------
ComputeProb: 'Compute probability using a bivariate binomial
             'distribution as a model
' DIM I AS INTEGER
  DIM J AS INTEGER
  DIM A AS DOUBLE
  DIM B AS DOUBLE
  DIM E(0 TO 24) AS DOUBLE  'Binomial coefficients, games to play each other
  DIM S(0 TO 24) AS DOUBLE  'Running sum of 2 * E[I]
  DIM F(0 TO 162) AS DOUBLE 'B. C., games not played with each other
  DIM G(0 TO 162) AS DOUBLE 'Sum of 2 * E[I] for 2nd place team win, E[I] for tie

  A = GL1 + GL2 - GE - GE 'A = not played with each other games
  B = 1
  F(0) = 1
  FOR I = 1 TO MNT1 'Compute binomial coefficients
    F(I) = F(I - 1) * A / B
    A = A - 1
    B = B + 1
  NEXT I
  A = GE
  B = 1
  E(0) = 1
  S(0) = 2
  FOR I = 1 TO GE 'Compute binomial coefficients
    E(I) = E(I - 1) * A / B
    A = A - 1
    B = B + 1
    S(I) = S(I - 1) + 2 * E(I)
  NEXT I
  FOR I = 0 TO MNT1 'Compute G[I]
    J = INT((MNT1 - I) / 2)
    IF J <= GE THEN
      G(I) = S(J)
      IF (J + J) = (MNT1 - I) THEN G(I) = G(I) - E(J) ELSE 'Adjust for tie
    ELSE
      G(I) = S(GE)
    END IF
  NEXT I
IF Debug THEN
  GOSUB DisplayCase
  FOR I = 0 TO MNT1
    PRINT "F["; I; "] = "; F(I)
  NEXT I
  PRINT
  PRINT "Press any key to continue...": Ch$ = INPUT$(1)
  PRINT
  FOR I = 0 TO GE
    PRINT "E["; I; "] = "; E(I)
  NEXT I
  PRINT
  PRINT "Press any key to continue...": Ch$ = INPUT$(1)
  PRINT
  FOR I = 0 TO GE
    PRINT "S["; I; "] = "; S(I)
  NEXT I
  PRINT
  PRINT "Press any key to continue...": Ch$ = INPUT$(1)
  PRINT
  FOR I = 0 TO MNT1
    PRINT "G["; I; "] = "; G(I)
  NEXT I
  PRINT
  PRINT "Press any key to continue...": Ch$ = INPUT$(1)
  PRINT
END IF 'Debug
  Q = 0
  FOR I = 0 TO MNT1 'Compute probability that 2nd place team beats 1st place team
    Q = Q + F(I) * G(I)
  NEXT I
  A = GL1 + GL2 - GE + 1
  B = EXP(A * LOG(2#))  '2 ** Flips (natural log)
  Q = Q / B
  P = 1 - Q
RETURN 'ComputeProb

'--------------------------------------
DisplayProb: 'Display probability
  PRINT USING "#####.####"; P;
  PRINT " = P = Probability that 1st place team beats 2nd place team"
  PRINT USING "#####.####"; Q;
  PRINT " = Q = Probability that 2nd place team beats 1st place team"
  IF Q > 0 THEN
    PRINT USING "#####.####"; 1 / Q;
    PRINT " = 1 / Q, (Odds = ";
    PRINT USING "#.####"; P / Q;
    PRINT " : 1)"
  END IF
  PRINT
RETURN 'DisplayProb

'--------------------------------------
SUB ReadInt (Mess AS STRING, Min AS INTEGER, Max AS INTEGER, Nom AS INTEGER, I AS INTEGER)
  'Read in an integer from keyboard

  DIM LI AS LONG

  DO
    PRINT Mess
    PRINT "  ["; Min; ","; Max; "] (ENTER => "; Nom;
    INPUT "): ", St$
    LI = VAL(St$)
  LOOP UNTIL ((LI >= Min) AND (LI <= Max)) OR (St$ = "")
  IF St$ = "" THEN LI = Nom
  I = LI
  PRINT "Input = "; I
  PRINT
END SUB 'ReadInt

'--------------------------------------
SUB ReadReal (Mess AS STRING, Min AS DOUBLE, Max AS DOUBLE, Nom AS DOUBLE, R AS DOUBLE)
  'Read in a Real from keyboard

  DO
    PRINT Mess
    PRINT "  ["; : PRINT USING "#.#"; Min; : PRINT ", ";
    PRINT USING "###.#"; Max; : PRINT "] (ENTER => ";
    PRINT USING "#.#"; Nom;
    INPUT "): ", St$
    R = VAL(St$)
  LOOP UNTIL ((R >= Min) AND (R <= Max)) OR (St$ = "")
  IF St$ = "" THEN R = Nom
  PRINT "Input = "; : PRINT USING "###.#"; R
  PRINT

END SUB 'ReadReal 'End of file BBallQ.Bas *************************************