1000  COM R1,R2,R3,R4,R$[72],N,C[30,4],A$[72],F1,F2,F[125]
1001  COM C1,C2,C4,B$[72],S[5,2],D$[5],A[150],L1,L2
1010  REM *** COFTAB - PROGRAM COFTA7 - 06/06/73
1012  REM *** CALCULATES THE STATISTICS.
1013  REM *** TRANSFRERS CONTROL TO COFTA6.
5010  Z$='10'10'13"DEGREES OF FREEDOM: ###"'10'13
5020  Z[1]=(L1-1)*(L2-1)
5030  L3=L1
5040  L4=L2
5050  GOSUB 7480
5060  X3=A[(L1+1)*(L2+1)]
5070  X5=X6=X7=0
5080  FOR I=1 TO L2
5090  X1=A[I*(L1+1)]
5100  FOR J=1 TO L1
5110  X2=A[(L1+1)*L2+J]
5120  E=X1*X2/X3
5130  X4=A[(I-1)*(L1+1)+J]
5140  X5=X5+(X4-E)^2/E
5150  X6=X6+X4*X4/X1
5160  NEXT J
5170  NEXT I
5180  FOR J=1 TO L1
5190  X2=A[(L1+1)*L2+J]
5200  X7=X7+X2*X2
5210  NEXT J
5220  Z[1]=X5+.0005
5230  Z$="CHI-SQUARE: ###.###"'10'13
5240  GOSUB 7480
5250  G1=Z[1]
5260  L2=(L1-1)*(L2-1)
5270  L1=1000
5280  G=G1/L2
5290  LET P=1
5300  IF G*L1*L2=0 THEN 5580
5310  IF G<1 THEN 5360
5320  A=L2
5330  B=L1
5340  F=G
5350  GOTO 5390
5360  A=L1
5370  B=L2
5380  LET F=1/G
5390  LET A1=2/(9*A)
5400  LET B1=2/(9*B)
5410  Z=ABS((1-B1)*F^(.333333)-1+A1)
5420  LET Z=Z/SQR(B1*F^(.666667)+A1)
5430  IF B<4 THEN 5470
5440  LET P=(1+Z*(.196854+Z*(.115194+Z*(.000344+Z*.019527))))^4
5450  P=.5/P
5460  GOTO 5490
5470  LET Z=Z*(1+.08*Z^4/B^3)
5480  GOTO 5440
5490  IF G<1 THEN 5510
5500  GOTO 5520
5510  P=1-P
5520  Z[1]=INT(100000.*P)/100000.+.0005
5530  Z$="EXACT PROBABILITY OF CHI-SQUARE:  #.###"'13'10
5540  GOSUB 7480
5550  L1=L3
5560  L2=L4
5570  Z[1]=SQR(X5/(X5+X3))+.0005
5580  Z$="CONTINGENCY COEFFICIENT:  #.###"'13'10
5590  GOSUB 7480
5600  Z[1]=Z[1]/SQR((L1+L2-2)/(L1+L2))
5610  Z$="CORRECTED CONTINGENCY COEFFICIENT:  #.###"'13'10
5620  GOSUB 7480
5630  Z[1]=SQR(X5/(X3*((L1 MIN L2)-1)))+.0005
5640  Z$="CRAMER'S V:  #.###"'13'10
5650  GOSUB 7480
5660  X8=X7/X3
5670  Z[1]=(X6-X8)/(X3-X8)+.0005
5680  Z$="GOODMAN-KRUSKAL'S TAU-C:  #.###"'13'10
5690  GOSUB 7480
6000  A$='7"XYZ"
6010  CHAIN "COFTA6"
7480  REM *** SUBROUTINE TO FORMAT PROGRAM OUTPUT
7510  LET Z2=Z3=Z4=Z5=Z7=Z8=Z9=1
7520  DIM Y$[10],Z$[72]
7530  LET Y$="0123456789"
7540  LET Z0=Z9-1
7550  LET Z0=Z0+1
7560  IF Z0=LEN(Z$)+1 THEN 8070
7570  IF Z$[Z0,Z0]="#" THEN 7640
7580  IF Z$[Z0,Z0+1]=".#" THEN 7640
7590  IF Z$[Z0,Z0+1]="+#" THEN 7620
7600  PRINT Z$[Z0,Z0];
7610  GOTO 7550
7620  LET Z4=0
7630  GOTO 7550
7640  LET Z=100
7650  LET Z6=Z[Z2]
7660  LET Z9=Z0-1
7670  LET Z9=Z9+1
7680  IF Z$[Z9,Z9]="." THEN 7710
7690  IF Z$[Z9,Z9]="#" THEN 7670
7700  GOTO 7750
7710  IF Z5#1 THEN 7750
7720  LET Z5=0
7730  LET Z=Z9
7740  GOTO 7670
7750  IF Z#100 THEN 7770
7760  LET Z=Z9
7770  IF Z4=1 THEN 7820
7780  IF Z6 >= 0 THEN 7810
7790  PRINT "-";
7800  GOTO 7820
7810  PRINT " ";
7820  LET Z6=ABS(Z6)+10^(Z-Z9-1)
7830  FOR Z1=Z-Z0 TO Z+1-Z9 STEP -1
7840  IF Z$[Z-Z1,Z-Z1]#"." THEN 7890
7850  PRINT ".";
7860  LET Z3=0
7870  LET Z7=2
7880  GOTO 8030
7890  LET Z8=INT(Z6/(10^(Z1+Z7-2)))
7900  IF Z6<10^(Z-Z0) THEN 7930
7910  PRINT "#";
7920  GOTO 8030
7930  LET Z6=Z6-Z8*10^(Z1+Z7-2)
7940  IF Y$[Z8+1,Z8+1]="0" THEN 7960
7950  LET Z3=0
7960  IF Z3=0 THEN 8020
7970  IF Z1#1 THEN 8000
7980  PRINT "0";
7990  GOTO 8030
8000  PRINT " ";
8010  GOTO 8030
8020  PRINT Y$[Z8+1,Z8+1];
8030  NEXT Z1
8040  LET Z3=Z4=Z5=Z7=1
8050  LET Z2=Z2+1
8060  GOTO 7540
8070  RETURN 
8080  END 
