1000  COM R1,R2,R3,R4,R$[72],N,C[30,4],A$[72],O[72]
1001  COM F[5,60]
1010  REM *** COFTAB - PROGRAM COFTA4 - 06/06/73
1012  REM *** PRINTS OUT THE FREQUENCY TABLES GENERATED BY COFTA3.
1013  REM *** TRANSFERS CONTROL BACK TO COFTA1.
2000  FILES VARBLE,WORK1,WORK2
5000  DIM T$[72],B$[72],S$[72],N$[72],U$[72],E$[1]
5010  DIM C$[72]
5020  DIM D$[20]
5030  DIM I[330]
5060  D$=",;)(=NX   0123456789"
5070  Z$="   ######         ###.##"'10'13
5080  F=3
5090  A1=INT(72/N)
5400  FOR I=1 TO N
5410  READ #1,1
5420  READ #1;T1,A$
5430  IF T1#ABS(C[I,4]) THEN 5420
5440  P2=0
5450  GOSUB 5850
5460  GOSUB 5980
5470  PRINT '10'10'10
5480  PRINT "VARIABLE:  "U$;TAB(25);C$
5490  IF O[I]#0 THEN 5530
5500  PRINT '10'10"*****OVERFLOW IN FREQUENCY TABLE"
5510  PRINT '10
5520  GOTO 5820
5530  PRINT '10
5540  PRINT " SYMBOL     FREQUENCY    PER CENTAGE"
5550  PRINT 
5560  O1=1+INT((C[I,2]-C[I,1]+1)/2)
5570  O1=O1*A1*64
5580  T5=A1*I-A1+1
5590  GOSUB 6240
5600  FOR J=1 TO C[I,3]
5610  READ #2,T5
5620  FOR K=1 TO I[J]
5630  READ #2;T$
5640  NEXT K
5650  IF T$#" " THEN 5720
5660  PRINT "  BLANK     ";
5670  Z[1]=F[I,I[J]]
5680  Z[2]=100*Z[1]/T
5690  Z[2]=Z[2]+.005
5700  GOSUB 7270
5710  GOTO 5770
5720  PRINT TAB(7-LEN(T$));T$;"     ";
5730  Z[1]=F[I,I[J]]
5740  Z[2]=Z[1]*100/T
5750  Z[2]=Z[2]+.005
5760  GOSUB 7270
5770  NEXT J
5780  PRINT '10"  TOTAL     ";
5790  Z[1]=T
5800  Z[2]=100
5810  GOSUB 7270
5820  NEXT I
5830  PRINT '10'10
5840  CHAIN "COFTA1"
5850  REM ***** ROUTINE FOR DECODING VAR STRING INTO VARIABLE LABEL
5860  B1=0
5870  GOSUB 6550
5880  IF S1=1 THEN 5930
5890  E1=0
5900  IF U7=2 THEN 5960
5910  PRINT "*****',' EXPECTED AFTER "A$[P1,P4]
5920  RETURN 
5930  U$=A$[P1,P4]
5940  E1=1
5950  RETURN 
5960  PRINT "*****SYNTAX ERROR IN "A$
5970  RETURN 
5980  REM ***** ROUTINE FOR UNPACKING COL.NOS. FROM VAR STRING
5990  B1=0
6000  GOSUB 6550
6010  IF S1#1 THEN 5910
6020  N$=A$[P1,P4]
6030  GOSUB 7100
6040  IF E1#0 THEN 6070
6050  IF U7=2 THEN 5960
6060  RETURN 
6070  U1=N1
6080  B1=0
6090  GOSUB 6550
6100  IF S1=7 OR S1=1 THEN 6140
6110  IF U7=2 THEN 5960
6120  PRINT "*****'CR' OR ',' EXPECTED AFTER "A$[P1,P4]
6130  RETURN 
6140  N$=A$[P1,P4]
6150  GOSUB 7100
6160  IF E1#0 THEN 6190
6170  IF U7=2 THEN 5960
6180  RETURN 
6190  U2=N1
6200  C$=""
6210  IF P2 >= A9 THEN 6230
6220  C$=A$[P2+1]
6230  RETURN 
6240  REM ***** ROUTINE TO SORT THE F(I,J)
6250  T=0
6260  FOR J=1 TO C[I,3]
6270  I[J]=J
6280  T=T+F[I,J]
6290  NEXT J
6300  FOR J=1 TO C[I,3]-1
6310  FOR K=J+1 TO C[I,3]
6320  IF F[I,I[J]] >= F[I,I[K]] THEN 6360
6330  T1=I[K]
6340  I[K]=I[J]
6350  I[J]=T1
6360  NEXT K
6370  NEXT J
6380  RETURN 
6550  REM ***** SCANNER
6560  A9=LEN(A$)
6570  P2=P1=P2+1
6580  IF P2 <= A9 THEN 6620
6590  P4=P2-1
6600  S1=7
6610  RETURN 
6620  GOSUB 7030
6630  IF S1=7 THEN 6590
6640  A9=LEN(A$)
6650  IF A$[P2,P2]#" " THEN 6720
6660  GOTO B1+1 OF 6690,6670,6720
6670  S1=8
6680  GOTO 7010
6690  IF P2 >= A9 THEN 6590
6700  A$=A$[P2+1]
6710  GOTO 6640
6720  IF A$[P2,P2]#"'" THEN 6890
6730  IF P2<A9 THEN 6770
6740  PRINT "*****MISMATCHED '"
6750  S1=0
6760  RETURN 
6770  A$[P2]=A$[P2+1]
6780  A9=LEN(A$)
6790  P2=P2+1
6800  IF P2>A9 THEN 6740
6810  IF A$[P2,P2]#"'" THEN 6790
6820  IF P2 >= A9 THEN 6850
6830  A$[P2]=A$[P2+1]
6840  GOTO 6640
6850  P2=P2-1
6860  A$=A$[1,P2]
6870  P4=P2
6880  GOTO 6600
6890  E$=A$[P2,P2]
6900  IF B1#2 THEN 6940
6910  IF E$#D$[2,2] THEN 6970
6920  I2=2
6930  GOTO 7000
6940  FOR I2=1 TO 5
6950  IF E$=D$[I2,I2] THEN 7000
6960  NEXT I2
6970  P2=P2+1
6980  IF P2>A9 THEN 6590
6990  GOTO 6640
7000  S1=I2
7010  P4=P2-1
7020  RETURN 
7030  REM ***** ROUTINE FOR SCANNING LEADING BLANKS
7040  S1=0
7050  IF A$[P2,P2]#" " THEN 7090
7060  P1=P2=P2+1
7070  IF P2 <= A9 THEN 7050
7080  S1=7
7090  RETURN 
7100  REM *****SUBROUTINE TO CONVERT STRING TO AN INTEGER (0-999)
7110  E1=1
7120  T1=LEN(N$)
7130  IF T1 <= 5 THEN 7170
7140  PRINT "*****"N$" IS AN ILLEGAL INTEGER"
7150  E1=0
7160  RETURN 
7170  N1=0
7180  FOR I2=T1 TO 1 STEP -1
7190  T$=N$[I2,I2]
7200  FOR J2=11 TO 20
7210  IF T$=D$[J2,J2] THEN 7240
7220  NEXT J2
7230  GOTO 7140
7240  N1=N1+(J2-11)*10^(T1-I2)
7250  NEXT I2
7260  RETURN 
7270  REM *** SUBROUTINE TO FORMAT PROGRAM OUTPUT
7300  LET Z2=Z3=Z4=Z5=Z7=Z8=Z9=1
7310  DIM Y$[10],Z$[72]
7320  LET Y$="0123456789"
7330  LET Z0=Z9-1
7340  LET Z0=Z0+1
7350  IF Z0=LEN(Z$)+1 THEN 7860
7360  IF Z$[Z0,Z0]="#" THEN 7430
7370  IF Z$[Z0,Z0+1]=".#" THEN 7430
7380  IF Z$[Z0,Z0+1]="+#" THEN 7410
7390  PRINT Z$[Z0,Z0];
7400  GOTO 7340
7410  LET Z4=0
7420  GOTO 7340
7430  LET Z=100
7440  LET Z6=Z[Z2]
7450  LET Z9=Z0-1
7460  LET Z9=Z9+1
7470  IF Z$[Z9,Z9]="." THEN 7500
7480  IF Z$[Z9,Z9]="#" THEN 7460
7490  GOTO 7540
7500  IF Z5#1 THEN 7540
7510  LET Z5=0
7520  LET Z=Z9
7530  GOTO 7460
7540  IF Z#100 THEN 7560
7550  LET Z=Z9
7560  IF Z4=1 THEN 7610
7570  IF Z6 >= 0 THEN 7600
7580  PRINT "-";
7590  GOTO 7610
7600  PRINT " ";
7610  LET Z6=ABS(Z6)+10^(Z-Z9-1)
7620  FOR Z1=Z-Z0 TO Z+1-Z9 STEP -1
7630  IF Z$[Z-Z1,Z-Z1]#"." THEN 7680
7640  PRINT ".";
7650  LET Z3=0
7660  LET Z7=2
7670  GOTO 7820
7680  LET Z8=INT(Z6/(10^(Z1+Z7-2)))
7690  IF Z6<10^(Z-Z0) THEN 7720
7700  PRINT "#";
7710  GOTO 7820
7720  LET Z6=Z6-Z8*10^(Z1+Z7-2)
7730  IF Y$[Z8+1,Z8+1]="0" THEN 7750
7740  LET Z3=0
7750  IF Z3=0 THEN 7810
7760  IF Z1#1 THEN 7790
7770  PRINT "0";
7780  GOTO 7820
7790  PRINT " ";
7800  GOTO 7820
7810  PRINT Y$[Z8+1,Z8+1];
7820  NEXT Z1
7830  LET Z3=Z4=Z5=Z7=1
7840  LET Z2=Z2+1
7850  GOTO 7330
7860  RETURN 
7870  END 
