0010 REM RANKDUB.BAS, DAVID ROTHMAN, 11/9/90
 0020 REM MAXIMUM LIKELIHOOD ESTIMATES OF LOGITS
 0040 DEFINT I-N,S,P,W
 0050 DEFDBL A-H,O,Q,R,T-V,X-Z
 0060 DIM N(685,20),AVE(685),XZ(685,3),GR(2),IJ(2),YY(2)
 0070 OPEN "I",#5, "XDIV.DB"
 0080 OPEN "I",#4, "GUESS.DB"
 0085 OPEN "I",#3, "SCORE.DB"
 0110 OPEN "O",#8, "ITERATE.DB"
 0120 DLIM = .5D0
 0130 FOR I=1 TO 64
 0140 IF 1D0+DLIM = 1D0 GOTO 0170
 0150 DLIM = DLIM/2D0
 0160 NEXT I
 0170 DLIM = DLIM*8D0
 0190 INPUT#5,NTEAM,NGAME,NIT
 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 NUMBER OF ITERATIONS ALLOWED
 0270 REM EACH TEAM MUST HAVE NO MORE THAN 20 GAMES
 0289 NSKED = 20
 0290 FAC = 1.813799364234218D0/15D0
 0300 XZM = 0D0
 0315 FOR I=1 TO NTEAM
 0360 INPUT#4,XZ(I,0)
 0370 REM FIRST GUESSES FOR LOGITS OF TEAMS (IN ORDER)
 0400 XZM = XZM+XZ(I,0)
 0410 NEXT I
 0414 CLOSE #4
 0415 CLOSE #5
 0510 TEAM = NTEAM
 0520 XZM = XZM/TEAM
 0522 FOR I=1 TO NTEAM
 0523 XZ(I,0) = EXP(FAC*(XZ(I,0)-XZM))
 0524 AVE(I) = 0D0
 0525 FOR J=1 TO NSKED
 0526 N(I,J) = 0
 0527 NEXT J
 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
 0640 DEL = S2-S1
 0650 REM GRADE THIS MARGIN
 0660 R = .25D0
 0670 IF DEL < 0D0 THEN R = .5D0 ELSE IF DEL > 0D0 THEN R = 0D0
 0690 GR(1) = R+.5D0/(1D0+EXP(FAC*DEL))
 0700 GR(2) = 1D0-GR(1)
 0720 IJ(1) = I1
 0730 IJ(2) = I2
 0740 FOR K=1 TO 2
 0750 IJK = IJ(K)
 0810 REM ACCUMULATE GRADES
 0820 AVE(IJK) = AVE(IJK)+GR(K)
 0830 REM COMPOSE INCIDENCE MATRIX
 0840 FOR J=1 TO NSKED
 0850 IF N(IJK,J) = 0 THEN GOTO 0890
 0860 NEXT J
 0865 GOSUB 2050
 0870 PRINT#8," TOO MANY GAMES AGAINST ",N$
 0880 STOP
 0890 N(IJK,J) = IJ(3-K)
 0900 NEXT K
 0910 NEXT I
 0915 CLOSE #3
 0920 REM ACCELERATED ONE-AT-A-TIME CONVERGENCE OF ESTIMATES
 0930 FOR II=1 TO NIT
      ISA = 1
      IF (II\9)*9 = II THEN ISA = 0
 0931 FOR NNN=-3 TO 2
 0932 NN = NNN
 0933 IF NN < 0 THEN NN = 0
 0936 NN1 = NN+1
 0937 IF NNN < 0 THEN NN1 = 0
 0940 MARK = 0
 0950 FOR I=1 TO NTEAM
 0955 XZ(I,NN1) = XZ(I,NN)
 0960 IF N(I,1) = 0 THEN GOTO 1070
 0965 MM = NN
 0966 IF N(I,1) < I THEN MM = NN1
 0970 F = 1D0/(XZ(I,NN)+XZ(N(I,1),MM))
 0980 FOR J=2 TO NSKED
 0990 IF N(I,J) = 0 THEN GOTO 1020
 0995 MM = NN
 0996 IF N(I,J) < I THEN MM = NN1
 1000 F = F+1D0/(XZ(I,NN)+XZ(N(I,J),MM))
 1010 NEXT J
 1020 XX = AVE(I)/F
 1030 XU = XX-XZ(I,NN)
 1040 IF XU = 0D0 THEN GOTO 1070
 1050 IF ABS(XU) > DLIM*XX THEN MARK = MARK+1
 1060 XZ(I,NN1) = XX
 1070 NEXT I
 1074 IF MARK = 0 THEN GOTO 1110
 1076 NEXT NNN
      Q1 = 0D0
      Q2 = 0D0
      FOR I=1 TO NTEAM
      XZ(I,0) = LOG(XZ(I,2)/XZ(I,1))
      XZ(I,1) = LOG(XZ(I,3)/XZ(I,2))
      Q1 = Q1+XZ(I,0)*XZ(I,1)
      Q2 = Q2+XZ(I,0)*XZ(I,0)
      NEXT I
      RA = Q1/Q2
      RAL = 1D0-.1D0/MARK
      IF RA > RAL THEN RA = RAL
      Q = 1D0/(1D0-RA)
      PRINT RA
 1080 IF ISA = 0 THEN OPEN "O",#9, "NEWGUESS.DB"
      FOR I=1 TO NTEAM
      Q3 = Q
      IF ABS(XZ(I,0)) <= ABS(XZ(I,1)) THEN GOTO 1090
      Q4 = XZ(I,0)/(XZ(I,0)-XZ(I,1))
      IF Q4 > Q3 THEN GOTO 1090
      IF Q4 < 1D0 THEN Q4 = 1D0
      Q3 = Q4
 1090 R = LOG(XZ(I,2))+XZ(I,1)*Q3
      IF ISA = 0 THEN PRINT#9,R/FAC+XZM
      XZ(I,0) = EXP(R)
      NEXT I
      IF ISA > 0 THEN GOTO 1099
      CLOSE #9
      PRINT "#9 CLOSED"
 1099 NEXT II
      NN1 = 0
 1100 II = NIT
 1110 PRINT#8,USING " ####";II;
 1111 PRINT#8, " ITERATIONS.  CRITERION UNMET FOR";
 1112 PRINT#8,USING " ###";MARK;
 1113 PRINT#8, " TEAMS."
 1115 CLOSE #8
 1210 REM GET LOGIT
      OPEN "O",#9, "NEWGUESS.DB"
 1290 FOR I=1 TO NTEAM
 1320 PRINT#9,USING " +###.#################";LOG(XZ(I,NN1))/FAC+XZM
 1330 NEXT I
 1340 CLOSE #9
 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