0010 REM FUT.BAS, DAVID ROTHMAN, 11/7/87 0020 REM PRINTS FUNCTIONS OF LOGIT ESTIMATES FOR FOOTBALL 0040 DEFINT I-N,S,P,W 0050 DEFDBL Z 0055 DIM GR(2),IJ(2),DI$(685),PF(685),PA(685),WN(3,685) 0060 DIM RRE(685),IRAN(685),AVE(685),XZ(685),EN(685) 0065 DIM EL(9),ID(2,9),S(2,9),P$(33) 0070 OPEN "I",#5, "XDIV.DB" 0080 OPEN "I",#4, "GUESS.DB" 0085 OPEN "I",#3, "SCORE.DB" 0090 OPEN "O",#6, "STANDING.DB" 0190 INPUT#5,NTEAM,NGAME,NIT,NA$ 0200 REM FIRST ENTRY IS NUMBER OF TEAMS--NO MORE THAN 685 0210 REM SECOND ENTRY IS NUMBER OF GAMES 0250 REM THIRD ENTRY IS NOT USED 0260 REM LAST ENTRY IS TITLE OVER OUTPUT (37 CHARACTERS) 0265 DF = NGAME-NTEAM+1 0266 IF DF < 2. THEN DF = 1. 0267 NOUT = LOG(DF) 0268 NOUT1 = NOUT-1 0271 PRINT#6," ";NA$ 0272 PRINT#6," BASED ON"; 0273 PRINT#6,USING " ####";NGAME; 0274 PRINT#6, " GAMES BETWEEN"; 0275 PRINT#6,USING " ###";NTEAM; 0277 PRINT#6, " TEAMS, AND NO OTHER INFORMATION" 0278 PRINT#6," " 0279 PRINT#6," FOUNDATION FOR THE ANALYSIS OF "; 0280 PRINT#6,"COMPETITIONS AND TOURNAMENTS" 0281 PRINT#6," " 0282 PRINT#6," RANK TEAM DIVISION LOGIT "; 0283 PRINT#6,"PCT. RRE PF PA W L T" 0284 PRINT#6," " 0289 NSKED = 21 0290 FAC = 1.8137993642/15. 0300 NTM1 = NTEAM-1 0310 ENM1 = NTM1 0315 FOR I=1 TO NTEAM 0360 INPUT#4,XZ(I) 0370 REM FIRST GUESSES FOR LOGITS OF TEAMS (IN ORDER) 0390 INPUT#5,DI$(I) 0400 REM DIVISION OF TEAM (BLANK IF NCAA DIVISION I-A) 0410 NEXT I 0414 CLOSE #4 0415 CLOSE #5 0420 XZM = 0. 0430 FOR I=1 TO NTEAM 0440 FOR J=1 TO 3 0450 WN(J,I) = 0 0460 NEXT J 0465 EN(I) = 1E-35 0470 PF(I) = 0 0480 PA(I) = 0 0490 XZM = XZM+XZ(I) 0500 NEXT I 0510 TEAM = NTEAM 0520 XZM = XZM/TEAM 0522 FOR I=1 TO NTEAM 0523 XZ(I) = EXP(FAC*(XZ(I)-XZM)) 0524 AVE(I) = 0. 0528 NEXT I 0530 FOR I=1 TO NGAME 0540 INPUT#3,I1,S1,I2,S2 0550 REM FIRST ENTRY IS INDEX OF FIRST TEAM IN GAME 0560 REM SECOND ENTRY IS SCORE OF FIRST TEAM IN GAME 0570 REM THIRD ENTRY IS INDEX OF SECOND TEAM IN GAME 0580 REM FOURTH ENTRY IS SCORE OF SECOND TEAM IN GAME 0600 PF(I1) = PF(I1)+S1 0610 PA(I1) = PA(I1)+S2 0620 PF(I2) = PF(I2)+S2 0630 PA(I2) = PA(I2)+S1 0640 DEL = S2-S1 0650 REM GRADE THIS MARGIN 0660 R = .25 0670 IF DEL < 0. THEN R = .5 ELSE IF DEL > 0. THEN R = 0. 0690 GR(1) = R+.5/(1.+EXP(FAC*DEL)) 0700 GR(2) = 1.-GR(1) 0720 IJ(1) = I1 0730 IJ(2) = I2 0740 FOR K=1 TO 2 0750 IJK = IJ(K) 0753 EN(IJK) = EN(IJK)+1. 0755 REM ACCUMULATE WINS, LOSSES, AND TIES 0760 A = GR(K)-GR(3-K) 0770 J = 1 0780 IF A = 0. THEN J = 3 0790 IF A < 0. THEN J = 2 0800 WN(J,IJK) = WN(J,IJK)+1 0810 REM ACCUMULATE GRADES 0820 AVE(IJK) = AVE(IJK)+GR(K) 0900 NEXT K 0910 NEXT I 0915 CLOSE #3 1120 REM COMPUTE AVERAGE GRADE (PCT.) 1130 FOR I=1 TO NTEAM 1190 AVE(I) = AVE(I)/EN(I) 1200 NEXT I 1210 REM GET RRE 1220 FOR I=1 TO NTEAM 1230 RRE(I) = 0. 1240 FOR J=1 TO NTEAM 1250 RRE(I) = RRE(I)+1./(XZ(I)+XZ(J)) 1260 NEXT J 1270 RRE(I) = (RRE(I)*XZ(I)-.5)/ENM1 1280 NEXT I 1290 FOR I=1 TO NTEAM 1300 IRAN(I) = I 1310 XZ(I) = LOG(XZ(I))/FAC+XZM 1330 NEXT I 1340 IF NOUT = 0 THEN GOTO 1386 1350 FOR I=1 TO NOUT 1360 EL(I) = 1. 1370 NEXT I 1380 REM LN(DF) LEAST LIKELY RESULTS (APPROX. THEORY) 1385 REM EXACT LOG LIKELIHOOD OF SAMPLE 1386 ABC = 0. 1390 OPEN "I",#3, "SCORE.DB" 1400 FOR I=1 TO NGAME 1410 INPUT#3,I1,S1,I2,S2 1420 DEL = S2-S1 1430 R = .25 1440 IF DEL < 0. THEN R = .5 ELSE IF DEL > 0. THEN R = 0. 1450 GR(1) = R+.5/(1.+EXP(FAC*DEL)) 1460 GR(2) = 1.-GR(1) 1470 Z = EXP(FAC*(XZ(I1)-XZ(I2))) 1480 Z1 = Z/(1.+Z) 1483 ZC = 1.-Z1 1485 ABC = ABC+GR(1)*LOG(Z1)+GR(2)*LOG(ZC) 1490 X = (Z1/GR(1))^GR(1)*(ZC/GR(2))^GR(2) 1500 IF NOUT = 0 OR X > EL(NOUT) THEN GOTO 1700 1510 EL(NOUT) = X 1520 ID(1,NOUT) = I1 1530 ID(2,NOUT) = I2 1540 S(1,NOUT) = S1 1550 S(2,NOUT) = S2 1555 IF NOUT1 < 1 THEN GOTO 1700 1560 FOR J=NOUT1 TO 1 STEP -1 1570 IF EL(J) < EL(J+1) THEN GOTO 1700 1580 T = EL(J) 1590 EL(J) = EL(J+1) 1600 EL(J+1) = T 1610 FOR K=1 TO 2 1620 II = ID(K,J) 1630 ID(K,J) = ID(K,J+1) 1640 ID(K,J+1) = II 1650 II = S(K,J) 1660 S(K,J) = S(K,J+1) 1670 S(K,J+1) = II 1680 NEXT K 1690 NEXT J 1700 NEXT I 1705 CLOSE #3 1706 OPEN "O", #3, "LIKE.DB" 1707 PRINT#3, ABC 1708 CLOSE #3 1710 REM PERCOLATOR SORT OF LOGITS 1720 LLA = 1 1730 FOR L=LLA TO NTM1 1740 IF XZ(IRAN(L)) >= XZ(IRAN(L+1)) THEN GOTO 1810 1750 IT = IRAN(L) 1760 IRAN(L) = IRAN(L+1) 1770 IRAN(L+1) = IT 1780 IF L = 1 THEN GOTO 1810 1790 LLA = L-1 1800 GOTO 1730 1810 NEXT L 1816 FOR M=1 TO NTEAM STEP 33 1817 OPEN "I",#2, "TEAM.DB" 1818 FOR K=1 TO NTEAM 1819 INPUT#2,N$ 1820 MP = M+32 1821 IF NTEAM < MP THEN MP = NTEAM 1822 FOR L=M TO MP 1823 I = IRAN(L) 1824 IF K = I THEN GOTO 1827 1825 NEXT L 1826 GOTO 1828 1827 P$(L+1-M) = N$ 1828 NEXT K 1829 CLOSE #2 1831 MP = M+32 1832 IF NTEAM < MP THEN MP = NTEAM 1835 FOR L=M TO MP 1836 I = IRAN(L) 1840 PRINT#6,USING " ### \ \";L;P$(L+1-M); 1843 PRINT#6,USING " \ \#####.## .###";DI$(I);XZ(I);AVE(I); 1847 PRINT#6,USING " .### ### ###";RRE(I);PF(I);PA(I); 1848 PRINT#6,USING " ## ## #";WN(1,I);WN(2,I);WN(3,I) 1850 REM PCT. DENOTES AVERAGE GRADED MARGIN 1860 REM RRE DENOTES ROUND ROBIN EQUIVALENT OF PCT. 1870 REM PF DENOTES TOTAL POINTS SCORED FOR TEAM 1880 REM PA DENOTES TOTAL POINTS SCORED AGAINST TEAM 1890 NEXT L 1895 NEXT M 1899 IF NOUT = 0 THEN GOTO 1990 1900 PRINT#6, " " 1906 PRINT#6,USING " LN(####";NGAME; 1907 PRINT#6, "-"; 1908 PRINT#6,USING "###+1) ";NTEAM; 1910 PRINT#6, "LEAST LIKELY RESULTS OF TOURNAMENT (APPROX. THEORY)" 1920 PRINT#6, " " 1930 FOR L=1 TO NOUT 1960 PRINT#6,USING " #";L; 1962 FOR K=1 TO 2 1964 IJK = ID(K,L) 1966 GOSUB 2050 1970 PRINT#6,USING " \ \";N$; 1971 PRINT#6,USING " \ \ ##";DI$(IJK);S(K,L); 1975 NEXT K 1977 PRINT#6,USING " .###";EL(L) 1980 NEXT L 1990 PRINT#6, " " 2000 PRINT#6, " DAVID ROTHMAN, EXECUTIVE DIRECTOR, FACT,"; 2010 PRINT#6, " 14125 DOTY AVENUE, #23," 2020 PRINT#6, " HAWTHORNE, CA 90250-8042, (310)676-4032, drothman1@juno.com" 2030 CLOSE #6 2040 END 2045 REM FIND IJK-TH TEAM NAME 2050 OPEN "I",#2, "TEAM.DB" 2060 FOR KK=1 TO IJK 2070 INPUT#2,N$ 2080 NEXT KK 2090 CLOSE #2 2100 RETURN