5  COM X[1000]
10  COM L[6],B[6],F[6],P[6],T$[5],N4,T,W,O,N7,W9,N1,N2,L1,Q9,T1
330  DIM S[100],U[100],D[100],Z$[19]
340  REM: THIS PROGRAM IS CHAINED TO FROM 'ANOVA'
350  REM: IT PERFORMS THE CALCULATIONS FOR UP TO A 
360  REM: 5-WAY FACTORIAL ANALYSIS OF VARIANCE
370  REM: ANOVA, HP 36870A, 6/74
380  REM: 2000F VERSION: MODIFIED 06/30/73
390  REM:
740  LET G9=INT((T1/N2+.005)*100)*.01
750  PRINT "GRAND MEAN=";G9
760  PRINT 
770  PRINT 
780  LET C=T1^2/O
790  REM: BINARY COUNTER
800  FOR J=1 TO N4
810  LET F[J]=B[J]=0
820  NEXT J
830  LET N3=0
840  LET C1=N1-2
850  FOR J=1 TO C1
860  IF Q9=0 THEN 950
870  IF J >= N1/2 THEN 950
880  LET K9=16
890  PRINT "VARIABLES";
900  FOR K=1 TO N4-1
910  PRINT TAB(K9);T$[K,K];
920  LET K9=K9+6
930  NEXT K
940  PRINT 
950  LET U[J]=S[J]=D[J]=N=0
960  LET N=N+1
970  IF B[N] <= 0 THEN 1000
980  LET B[N]=0
990  GOTO 960
1000  LET B[N]=1
1010  LET N3=N3+1
1020  LET S2=0
1030  FOR K=1 TO N4
1040  LET F[K]=B[K]
1050  NEXT K
1060  LET F1=1
1070  FOR K=1 TO N4
1080  IF F[K] <= 0 THEN 1100
1090  LET F1=F1*L[K]
1100  NEXT K
1110  REM: THIS CHANGES BINARY COUNTER INTO DIGITS
1120  LET K1=N4+1
1130  LET M=O/F1
1140  LET M1=0
1150  FOR H=1 TO F1
1160  LET X1=1
1170  LET M1=M1+1
1180  LET U1=K1-X1
1190  IF (M1-1)=0 THEN 1210
1200  GOTO 1220
1210  GOTO 1350
1220  LET U1=K1-X1
1230  IF F[U1]>0 THEN 1270
1240  LET X1=X1+1
1250  LET U1=K1-X1
1260  GOTO 1230
1270  IF (F[U1]-L[U1])=0 THEN 1310
1280  IF (F[U1]-L[U1])>0 THEN 1540
1290  LET F[U1]=F[U1]+1
1300  GOTO 1350
1310  LET F[U1]=1
1320  LET X1=X1+1
1330  LET U1=K1-X1
1340  GOTO 1230
1350  LET S3=0
1360  LET X2=P2=1
1370  FOR Z=1 TO N4
1380  LET L2=F[Z]
1390  IF L2 <= 0 THEN 1410
1400  LET P2=P2+(L2-1)*P[Z]
1410  NEXT Z
1420  LET M2=X2=P2
1430  LET Z1=0
1440  FOR Z=1 TO N4
1450  IF F[Z]=0 THEN 1470
1460  GOTO 1520
1470  LET Z1=Z1+1
1480  LET F[Z]=1
1490  LET T2=P[Z]
1500  LET K9=Z
1510  GOTO 1530
1520  LET F[Z]=-F[Z]
1530  NEXT Z
1540  LET D1=1
1550  LET S3=S3+X[X2]
1560  FOR Z=1 TO N4
1570  IF F[Z] <= 0 THEN 1590
1580  LET D1=D1*L[Z]
1590  NEXT Z
1600  LET D1=D1-1
1610  LET J1=N4-K9+1
1620  FOR Q=1 TO D1
1630  LET K2=J1
1640  LET K=K1-K2
1650  IF F[K]>0 THEN 1810
1660  LET K2=K2+1
1670  LET K=K1-K2
1680  IF F[K] <= 0 THEN 1660
1690  IF (F[K]-L[K])<0 THEN 1720
1700  LET F[K]=1
1710  GOTO 1660
1720  LET F[K]=F[K]+1
1730  LET P2=M2
1740  FOR Z=1 TO N4
1750  LET L2=F[Z]
1760  IF L2-1 <= 0 THEN 1780
1770  LET P2=P2+(L2-1)*P[Z]
1780  NEXT Z
1790  LET X2=P2
1800  GOTO 1880
1810  IF F[K]-L[K]<0 THEN 1860
1820  LET F[K]=1
1830  LET K2=K2+1
1840  LET K=K1-K2
1850  GOTO 1650
1860  LET F[K]=F[K]+1
1870  LET X2=X2+T2
1880  LET S3=S3+X[X2]
1890  NEXT Q
1900  LET U[J]=U[J]+S3^2
1910  FOR Z=1 TO N4
1920  IF F[Z] >= 0 THEN 1950
1930  LET F[Z]=-F[Z]
1940  GOTO 1960
1950  LET F[Z]=0
1960  NEXT Z
1970  LET A=S3/M
1980  IF Q9=0 THEN 2060
1990  IF J >= N1/2 THEN 2060
2000  PRINT "L E V E L",
2010  FOR N=1 TO N4-1
2020  PRINT F[N];
2030  NEXT N
2040  LET A=.01*INT((A+.005)*100)
2050  PRINT "MEAN=";A
2060  NEXT H
2070  IF Q9=0 THEN 2140
2080  IF J >= N1/2 THEN 2140
2090  PRINT "FOR VARIABLE:  ";
2100  GOSUB 3310
2110  PRINT "  RAW SS=";U[J];TAB(60);"CODE=";J
2120  PRINT 
2130  PRINT 
2140  NEXT J
2150  PRINT TAB(23);"***** SUMMARY TABLE *****"
2160  PRINT "--------------------------------------------------";
2170  PRINT TAB(50);"---------------------"
2180  PRINT "SOURCE OF";TAB(25);"CODE";
2190  PRINT TAB(31);"SUM OF";TAB(43);"DEGREES OF";
2200  PRINT TAB(60);"MEAN"
2210  PRINT "VARIANCE";TAB(31);"SQUARES";TAB(43);"FREEDOM";
2220  PRINT TAB(59);"SQUARES"
2230  PRINT "--------------------------------------------------";
2240  PRINT TAB(50);"---------------------"
2250  REMM: BINARY COUNTER FOR SS VALUES
2260  FOR Z=1 TO N4
2270  LET B[Z]=0
2280  NEXT Z
2290  LET N5=N1-2
2300  FOR Y=1 TO N5
2310  LET N=0
2320  LET N=N+1
2330  IF B[N] <= 0 THEN 2360
2340  LET B[N]=0
2350  GOTO 2320
2360  LET B[N]=1
2370  LET V=D2=1
2380  FOR W=1 TO N4
2390  IF B[W]=0 THEN 2420
2400  LET V=V*L[W]
2410  LET D2=D2*(L[W]-1)
2420  NEXT W
2430  LET D[Y]=D2
2440  LET A1=V
2450  LET A1=O/A1
2460  LET O1=N=0
2470  LET N=N+1
2480  IF B[N] <= 0 THEN 2520
2490  LET B[N]=0
2500  LET O1=O1+1
2510  GOTO 2530
2520  LET B[N]=-1
2530  IF N-N4<0 THEN 2470
2540  LET U2=1
2550  REM: NUMBER OF TERMS TO BE SUBTRACTED
2560  FOR Z=1 TO O1
2570  LET U2=U2*2
2580  NEXT Z
2590  LET U2=U2-2
2600  REM: CORRECTION FACTOR
2610  LET C2=0
2620  IF U2 <= 0 THEN 2810
2630  FOR E=1 TO U2
2640  LET N=1
2650  IF B[N]<0 THEN 2700
2660  IF B[N]>0 THEN 2690
2670  LET B[N]=1
2680  GOTO 2720
2690  LET B[N]=0
2700  LET N=N+1
2710  GOTO 2650
2720  LET Q1=N=0
2730  LET Q2=1
2740  LET N=N+1
2750  IF B[N] <= 0 THEN 2770
2760  LET Q1=Q1+Q2
2770  LET Q2=Q2*2
2780  IF N-N4<0 THEN 2740
2790  LET C2=C2+S[Q1]
2800  NEXT E
2810  FOR N=1 TO N4
2820  IF B[N] >= 0 THEN 2850
2830  LET B[N]=0
2840  GOTO 2860
2850  LET B[N]=1
2860  NEXT N
2870  LET S[Y]=U[Y]/A1-C2-C
2880  IF D[Y]=0 THEN 2900
2890  LET A2=S[Y]/D[Y]
2900  IF Y >= N1/2 THEN 2920
2910  GOSUB 3310
2920  LET S[Y]=.01*INT((S[Y]+.005)*100)
2930  LET A2=.01*INT((A2+.005)*100)
2940  IF Y >= N1/2 THEN 2970
2950  PRINT TAB(25);Y;S[Y],D[Y],A2
2960  GOTO 2990
2970  LET N7=N7+S[Y]
2980  LET W9=W9+D[Y]
2990  NEXT Y
3000  IF L[N4]=1 THEN 3210
3010  LET C2=0
3020  FOR Z=1 TO N5
3030  LET C2=C2+S[Z]
3040  NEXT Z
3050  LET R=N1-1
3060  LET S[R]=0
3070  FOR W=1 TO N2
3080  LET S[R]=S[R]+X[W]^2
3090  NEXT W
3100  LET A1=1
3110  LET S[R]=S[R]/A1-C-C2
3120  LET D2=D[N1-2]
3130  LET D3=D2*(L[1]-1)
3140  LET D4=D3
3150  LET A2=S[R]/D4
3160  LET S[R]=.01*INT((S[R]+.005)*100)
3170  LET A2=.01*INT((A2+.005)*100)
3180  LET W8=INT(((N7+S[R])/(W9+D4)+.005)*100)*.01
3190  PRINT "ERROR";
3200  PRINT TAB(31);N7+S[R],W9+D4,W8
3210  LET T2=T-C
3220  LET T3=O-1
3230  PRINT "--------------------------------------------------"
3240  PRINT "TOTAL";TAB(31);T2;TAB(45);T3
3250  STOP 
3310  REM: PRINTING SUBROUTINE
3320  LET N9=1
3330  LET Z$="                   "
3340  FOR I=1 TO N4
3350  IF B[I]=0 THEN 3400
3360  LET Z$[N9,N9]=T$[I,I]
3370  IF N9=17 THEN 3420
3380  LET Z$[N9+1,N9+3]=" X "
3390  LET N9=N9+4
3400  NEXT I
3410  LET Z$[N9-2,N9+2]="     "
3420  PRINT Z$;
3430  RETURN 
9999  END 
