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