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 **************************************************