GWBASIC Version, Listing




1000 'Start of file BBallB.Bas ************************************************
1010 '
1020 NAMEIS$ = "BBallB - Baseball probability (if each game is a 50-50 chance)."
1030 VERSION$ = "GW-BASIC Version 2.03, last revised: 1993-09-27, 0600 hours"
1040 AUTHOR$ = "Copyright (c) 1981-1993 by author: Harry J. Smith,"
1050 ADDRESS$ = "19628 Via Monte Dr., Saratoga CA 95070.  All rights reserved."
1060 '
1070 '*************************************************************************
1080 '
1090 'Computes the probability that the 1st place team will beat the 2nd place
1100 'team for the division title, assuming each has a 50-50 chance of winning
1110 'any given future game. Uses a bivariate binomial distribution as a model
1120 '
1130 'Developed in Turbo Pascal 5.0, converted to QW-BASIC
1140 '
1150 'Global variables:
1160 ESC$ = CHR$(27)
1170 'TN1$    STRING  : Team's name, 1st place team
1180 'TN2$    STRING  : Team's name, 2nd place team
1190 'GL1%   INTEGER : Games Left to play, 1st place team
1200 'GL2%   INTEGER : Games Left to play, 2nd place team
1210 'GE%    INTEGER : Games to play each other
1220 'GA#    DOUBLE  : Games 1st place team is ahead. 0, 0.5, ...
1230 'GA2%   INTEGER : Twice games ahead = 2 * GA, 0, 1, ...
1240 'MNT1%  INTEGER : Magic Number to tie for 1st place team
1250 'MNW1%  INTEGER : Magic Number to win for 1st place team
1260 'MNT2%  INTEGER : Magic Number to tie for 2nd place team
1270 'MNW2%  INTEGER : Magic Number to win for 2nd place team
1280 'P#     DOUBLE  : Probability that 1st place team beats 2nd place team
1290 'Q#     DOUBLE  : Probability that 2nd place team beats 1st place team
1300 'DEBUG% INTEGER : <> 0 if debug turned on
1310 '
1320 OPTION BASE 0
1330 DIM CH$(1) ' Character
1340 '
1350 'Variables for subroutine ComputeProb
1360 DIM E#(24) 'DOUBLE : Binomial coefficients, games to play each other
1370 DIM S#(24) 'DOUBLE : Running sum of 2 * E[I]
1380 DIM F#(162) 'DOUBLE : B. C., games not played with each other
1390 DIM G#(162) 'DOUBLE : Sum of 2 * E#[I] for 2nd place team win, E#[I] for tie
1400 '
1410 'Variables for subroutine ReadInt : Read in an integer
1420 'Mess$  STRING  : Message
1430 'Min%   INTEGER : Min value
1440 'Max%   INTEGER : Max Value
1450 'Nom%   INTEGER : Nominal value
1460 'I%     INTEGER : Returned value
1470 '
1480 'Variables for subroutine ReadReal : Read in a Real number
1490 'Mess$  STRING  : Message
1500 'Min#   INTEGER : Min value
1510 'Max#   INTEGER : Max Value
1520 'Nom#   INTEGER : Nominal value
1530 'R#     INTEGER : Returned value
1540 '
1550 '--------------------------------------
1560 'Main program, BBallB
1570   DEBUG% = 0
1580 ' DO
1590     GOSUB 1730 'Init
1600     GOSUB 1850 'GetCase
1610     GOSUB 2110 'ExpandCase
1620     GOSUB 2380 'ComputeProb
1630     GOSUB 1730 'Init
1640     GOSUB 2230 'DisplayCase
1650     GOSUB 3150 'DisplayProb
1660     PRINT "Press any key to continue... (or ESC to exit)";
1670     CH$ = INPUT$(1)
1680   IF CH$ <> ESC$ THEN 1580 'LOOP
1690   END
1700 'End Main program, BBallB
1710 '
1720 '--------------------------------------
1730 'Init: Initialize program
1740   COLOR 14, 1 'Yellow on Blue
1750   CLS
1760   PRINT
1770   PRINT NAMEIS$
1780   PRINT VERSION$
1790   PRINT AUTHOR$
1800   PRINT ADDRESS$
1810   PRINT
1820 RETURN 'Init
1830 '
1840 '--------------------------------------
1850 'GetCase: Get data for a case to compute
1860 ' Giants, Braves 1993
1870   TN1$ = "Braves": TN2$ = "Giants"
1880   GL1% = 6: GL2% = 7: GE% = 0: GA# = 1.5 '1993-09-27, 1 / Q = 4.7175
1890   ST$ = "Games Left to play, 1st place team (-2 => Exit, -1 => Test case)"
1900   'CALL ReadInt(St$, -2, 162, -1, I%)
1910      MESS$ = ST$: MIN% = -2: MAX% = 162: NOM% = -1: GOSUB 3300
1920   IF I% = -2 THEN END
1930   IF I% >= 0 THEN :  ELSE 2070
1940     TN1$ = "        ": TN2$ = "        "
1950     GL1% = I%
1960     'CALL ReadInt("...", 0, 162, GL1%, GL2%)
1970        MESS$ = "Games Left to play, 2nd place team"
1980        MIN% = 0: MAX% = 162: NOM% = GL1%: GOSUB 3300: GL2% = I%
1990     'CALL ReadInt("...", 0, 24, 0, GE%)
2000        MESS$ = "Games to play each other"
2010        MIN% = 0: MAX% = 24: NOM% = 0: GOSUB 3300: GE% = I%
2020     'DO
2030       'CALL ReadReal("Games ahead, 0, 0.5, ...", 0, 162#, 0, GA)
2040          MESS$ = "Twice games ahead"
2050          MIN# = 0: MAX# = 162: NOM# = 0: GOSUB 3480: GA# = R#
2060     IF (INT(GA# + GA#) <> GA# + GA#) THEN 2020
2070   'END IF
2080 RETURN 'GetCase
2090 '
2100 '--------------------------------------
2110 'ExpandCase: Compute related data
2120   GA2% = CINT(2 * GA#) 'Round
2130   I% = GL1% + GL2% - GA2%
2140   IF (I% MOD 2 = 1) THEN :  ELSE 2170'if I% is odd
2150     PRINT "Error in data"
2160     PRINT "Press any key to continue...": CH$ = INPUT$(1)
2170   'END IF
2180   MNT1% = INT(I% / 2): MNW1% = MNT1% + 1
2190   MNT2% = GL1% + GL2% - MNT1%: MNW2% = MNT2% + 1
2200 RETURN 'ExpandCase
2210 '
2220 '--------------------------------------
2230 'DisplayCase:
2240   PRINT USING "########"; GL1%;
2250   PRINT " = Games Left to play, 1st place team ("; TN1$; ")"
2260   PRINT USING "########"; GL2%;
2270   PRINT " = Games Left to play, 2nd place team ("; TN2$; ")"
2280   PRINT USING "########"; GE%; : PRINT " = Games to play each other"
2290   PRINT USING "######.#"; GA#; : PRINT " = Games 1st place team is ahead.  0, 0.5, ..."
2300   PRINT USING "########"; MNT1%; : PRINT " = Magic Number to tie for 1st place team"
2310   PRINT USING "########"; MNW1%; : PRINT " = Magic Number to win for 1st place team"
2320   PRINT USING "########"; MNT2%; : PRINT " = Magic Number to tie for 2nd place team"
2330   PRINT USING "########"; MNW2%; : PRINT " = Magic Number to win for 2nd place team"
2340   PRINT
2350 RETURN 'DisplayCase
2360 '
2370 '--------------------------------------
2380 'ComputeProb: Compute probability using a bivariate binomial
2390              'distribution as a model
2400 ' I%  INTEGER
2410 ' J%  INTEGER
2420 ' A#  DOUBLE
2430 ' B#  DOUBLE
2440 ' DIM E#(24) 'DOUBLE : Binomial coefficients, games to play each other
2450 ' DIM S#(24) 'DOUBLE : Running sum of 2 * E[I]
2460 ' DIM F#(162) 'DOUBLE : B. C., games not played with each other
2470 ' DIM G#(162) 'DOUBLE : Sum of 2 * E#[I] for 2nd place team win, E#[I] for tie
2480 '
2490   A# = GL1% + GL2% - GE% - GE% 'A = not played with each other games
2500   B# = 1
2510   F#(0) = 1
2520   FOR I% = 1 TO MNT1% 'Compute binomial coefficients
2530     F#(I%) = F#(I% - 1) * A# / B#
2540     A# = A# - 1
2550     B# = B# + 1
2560   NEXT I%
2570   A# = GE%
2580   B# = 1
2590   E#(0) = 1
2600   S#(0) = 2
2610   FOR I% = 1 TO GE% 'Compute binomial coefficients
2620     E#(I%) = E#(I% - 1) * A# / B#
2630     A# = A# - 1
2640     B# = B# + 1
2650     S#(I%) = S#(I% - 1) + 2 * E#(I%)
2660   NEXT I%
2670   FOR I% = 0 TO MNT1% 'Compute G#[I%]
2680     J% = INT((MNT1% - I%) / 2)
2690     IF J% <= GE% THEN :  ELSE 2730
2700       G#(I%) = S#(J%)
2710       IF (J% + J%) = (MNT1% - I%) THEN G#(I%) = G#(I%) - E#(J%) ELSE 'Adjust for tie
2720       GOTO 2750
2730     'ELSE
2740       G#(I%) = S#(GE%)
2750     'END IF
2760   NEXT I%
2770   IF DEBUG% THEN :  ELSE 3030
2780     GOSUB 2230 'DisplayCase
2790     FOR I% = 0 TO MNT1%
2800       PRINT "F["; I%; "] = "; F#(I%)
2810     NEXT I%
2820     PRINT
2830     PRINT "Press any key to continue...": CH$ = INPUT$(1)
2840     PRINT
2850     FOR I% = 0 TO GE%
2860       PRINT "E["; I%; "] = "; E#(I%)
2870     NEXT I%
2880     PRINT
2890     PRINT "Press any key to continue...": CH$ = INPUT$(1)
2900     PRINT
2910     FOR I% = 0 TO GE%
2920       PRINT "S["; I%; "] = "; S#(I%)
2930     NEXT I%
2940     PRINT
2950     PRINT "Press any key to continue...": CH$ = INPUT$(1)
2960     PRINT
2970     FOR I% = 0 TO MNT1%
2980       PRINT "G["; I%; "] = "; G#(I%)
2990     NEXT I%
3000     PRINT
3010     PRINT "Press any key to continue...": CH$ = INPUT$(1)
3020     PRINT
3030   'END IF Debug
3040   Q# = 0
3050   FOR I% = 0 TO MNT1% 'Compute probability that 2nd place team beats 1st place team
3060     Q# = Q# + F#(I%) * G#(I%)
3070   NEXT I%
3080   A# = GL1% + GL2% - GE% + 1
3090   B# = EXP(A# * LOG(2#))  '2 ** Flips (natural log)
3100   Q# = Q# / B#
3110   P# = 1 - Q#
3120 RETURN 'ComputeProb
3130 '
3140 '--------------------------------------
3150 'DisplayProb: Display probability
3160   PRINT USING "#####.####"; P#;
3170   PRINT " = P = Probability that 1st place team beats 2nd place team"
3180   PRINT USING "#####.####"; Q#;
3190   PRINT " = Q = Probability that 2nd place team beats 1st place team"
3200   IF Q# > 0 THEN :  ELSE 3250
3210     PRINT USING "#####.####"; 1 / Q#;
3220     PRINT " = 1 / Q, (Odds = ";
3230     PRINT USING "#.####"; P# / Q#;
3240     PRINT " : 1)"
3250   'END IF
3260   PRINT
3270 RETURN 'DisplayProb
3280 '
3290 '--------------------------------------
3300 'SUB ReadInt(Mess$, Min%, Max%, Nom%, I%)
3310   'Read in an integer from keyboard
3320 '
3330 ' LF#  DOUBLE
3340 '
3350 ' DO
3360     PRINT MESS$
3370     PRINT "  ["; MIN%; ","; MAX%; "] (ENTER => "; NOM%;
3380     INPUT "): ", ST$
3390     LF# = VAL(ST$)
3400   IF ((LF# < MIN%) OR (LF# > MAX%)) AND (ST$ <> "") THEN 3350 'LOOP
3410   IF ST$ = "" THEN LF# = NOM%
3420   I% = LF#
3430   PRINT "Input = "; I%
3440   PRINT
3450 RETURN 'ReadInt
3460 '
3470 '--------------------------------------
3480 'SUB ReadReal(Mess$, Min#, Max#, Nom#, R#)
3490   'Read in a Real from keyboard
3500 '
3510 ' DO
3520     PRINT MESS$
3530     PRINT "  ["; : PRINT USING "#.#"; MIN#; : PRINT ", ";
3540     PRINT USING "###.#"; MAX#; : PRINT "] (ENTER => ";
3550     PRINT USING "#.#"; NOM#;
3560     INPUT "): ", ST$
3570     R# = VAL(ST$)
3580   IF ((LF# < MIN#) OR (LF# > MAX#)) AND (ST$ <> "") THEN 3350 'LOOP
3590   IF ST$ = "" THEN R# = NOM#
3600   PRINT "Input = "; : PRINT USING "###.#"; R#
3610   PRINT
3620 RETURN 'ReadInt
3630 '
3640 'End of file BBallB.Bas **************************************************

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