PDP-10 Archive: decus/20-0020/2222.sta from decus_20tap1

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - decus/20-0020/2222.sta
There are 2 other files named 2222.sta in the archive. Click here to see a list.
100'  NAME--2222-
110'
120'  DESCRIPTION--CALCULATES AND DISPLAYS THE DECOMPOSITION
130'  OF Q FOR A FOUR VARIABLE TABLE.
140'
150'  SOURCE--UNKNOWN
160'
170'  INSTRUCTIONS--THE SIXTEEN VARIABLES ARE INPUT A THROUGH P ACCORDING
180'  TO THE FOLLOWING TABLE.
190'
200'                        Y                           Y
210'                      -----                       -----
220'      S   T   X   :  -   +   :   S   T   X   :   -   +
230'   =======================================================
240'      +   +   +   :   A   B   :   -   +   +   :   I   J
250'    ======================================================
260'      +   +   -   :   C   D   :   -   +   -   :   K   L
270'    ======================================================
280'      +   -   +   :   E   F   :   -   -   +   :   M   N
290'    ======================================================
300'      +   -   -   :   G   H   :   -   -   -   :   O   P
310'    ======================================================
320'
330'  NOTE: TO TERMINATE EXECUTION SET A=....=P=0
340'
350'
360'  *  *  *  *  *  *  *  *  MAIN PROGRAM  *  *  *  *  *  *  *  *  *
370'
380 DEF FNR (A,B) = (A-B)/(A+B)
390  DEF FNP(A) = INT(1000* A + .5)/1000
400 DIM Q(24),W(24)
410 LET L(0) = 1
420 LET L(1) = 10
430 CHANGE L TO L$
440 LET Y$ = "  Y   "
450 LET X$ = "  X   "
460 LET T$ = "  T   "
470 LET S$ = "  S   "
480 REM FOUR VARIABLE ANALYSIS
490 PRINT
500 PRINT "ENTER YOUR SIXTEEN OBSERVATIONS"
510 INPUT A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P
520 LET R1 = A + B + I + J
530 LET R2 = C + D + K + L
540 LET R3 = E + F + M + N
550 LET R4 = G + H + O + P
560 LET C1 = A + C + E + G
570 LET C2 = B + D + F + H
580 LET C3 = I + K + M + O
590 LET C4 = J + L + N + P
600 LET Q = C1 + C2 + C3 + C4
610 IF Q = 0 THEN 3320
620 GO TO 3020
630 LET X1 = (B+F+J+N)*(C+G+K+O)
640 LET X2 = (A+E+I+M)*(D+H+L+P)
650 LET Q1 = FNR(X1,X2)
660 LET X3 = (B+D +J+L)*(E+G+M+O)
670 LET X4 = (A+C+I+K)*(F+H+P+N)
680 LET Q2 = FNR(X3,X4)
690 LET Q3 = ((C2*C3)-(C1*C4))/((C2*C3)+(C1*C4))
700 LET Q4 = ((R1*R4)-(R2*R3))/((R1*R4)+(R2*R3))
710 LET X5 = (B+A+F+E)*(L+K+P+O)
720 LET X6 = (D+C+H+G)*(J+I+M+N)
730 LET Q5 = FNR(X5,X6)
740 LET X7 = (A+B+C+D)*(N+M+O+P)
750 LET X8 = (E+F+G+H)*(I+J+K+L)
760 LET Q6 = FNR(X7,X8)
770 REM Q FOR BOTH CONTROLS TIED
780 LET A1 = B*C+F*G + J*K + N*O
790 LET A2 = A*D + E*H + I*L + M*P
800 LET S1 = FNR(A1,A2)
810 LET A3 = B*E + D*G + J*M + L*O
820 LET A4 = A*F + C*H + I*N +K*P
830 LET S2 = FNR(A3,A4)
840 LET A5 = B*I+ D*K + F*M + H*O
850 LET A6 = A*J + C*L + E*N + G*P
860 LET S3 = FNR (A5,A6)
870 LET A7 = B*H + A*G + J*P + I*O
880 LET A8 = D*F + C*E + L*N + K*M
890 LET S4 = FNR(A7,A8)
900 LET A9 = B*L + A*K + F*P + E*O
910 LET A0 = D*J + C*I + H*N + G*M
920 LET S5 = FNR (A9,A0)
930 LET C7 = B*N +A*M + D*P + C*O
940 LET C8 = F*J + E *I + H*L + G*K
950 LET S6 = FNR ( C7,C8)
960 REM Q WHEN ONE CONTROL TIED OTHER DIFFERENT
970 LET B1 = B*G + F*C + J*O + N*K
980 LET B2 = A*H + E*D + I*P + M*L
990 LET B8 = FNR (B1,B2)
1000 LET B3 = B*K + J*C + F*O + N*G
1010 LET B4 = A*L + I*D + E*P + M*H
1020 LET B9 = FNR(B3,B4)
1030 LET D1 = B*G + D*E + J*O + M*L
1040 LET D2 = A*H + F*C + I*P + N*K
1050 LET D8 = FNR (D1,D2)
1060 LET D3 = B*M + J*E + D*O + G*L
1070 LET D4 = A*N + I*F + C*P + H*K
1080 LET D9 = FNR (D3,D4)
1090 LET E1 = B*K + D*I + F*O + H*M
1100 LET E2 = A*L + C*J + E*P + G*N
1110 LET E8 = FNR (E1,E2)
1120 LET E3 = B*M + F*I + D*O + H*K
1130 LET E4 = A*N + E*J + C*P + G*L
1140 LET E9 = FNR(E3,E4)
1150 LET F1 = B*G + A*H + J*O + I*P
1160 LET F2 = D*E + F*C + L*M + K*N
1170 LET F8 = FNR (F1,F2)
1180 LET F3 = B*P + J*H + A*O + I*G
1190 LET F4 = D*N + L*F + C*M+ K*E
1200 LET F9 = FNR(F3,F4)
1210 LET G1 = B*K + A*L + F*O + E*P
1220 LET G2 = D*I + C*J + H*M + G*N
1230 LET G8 = FNR (G1,G2)
1240 LET G3 = B*P + F*L + A*O + E*K
1250 LET G4 = D*N + H*J + C*M + G*I
1260 LET G9 = FNR (G3,G4)
1270 LET H1 = B*M + A*N + D*O + C*P
1280 LET H2 = F*I + J*E + H*K + G*L
1290 LET H8 = FNR (H1,H2)
1300 LET H3 = B*P + D*N + A*O + C*M
1310 LET H4 = F*L + H*J + E*K +G*I
1320 LET H9 = FNR (H3,H4)
1330 REM Q WITH BOTH CONTROLS DIFFERENT
1340 LET K1 = B*O + F*K + N*C + J*G
1350 LET K2 = A*P + E*L + M* D + I*H
1360 LET T1 = FNR(K1,K2)
1370 LET K3 = B*O + D*M + L* E + J*G
1380 LET K4 = A*P + C*N + K*F + I*H
1390 LET T2 = FNR (K3,K4)
1400 LET K5 = B*O + D*M + H*I + F*K
1410 LET K6 = A*P + C*N + G*J + L*E
1420 LET T3 = FNR (K5,K6)
1430 LET K7 = B*O + A*P + I*H + J*G
1440 LET K8 = D*M + C*N + K*F + L*E
1450 LET T4 = FNR (K7,K8)
1460 LET K9 = B*O +A*P +E*L + F*K
1470 LET K0 = D*M + C*N + G*J + I*H
1480 LET T5 =FNR(K9,K0)
1490 LET C9 = B*O + A*P + C*N + D*M
1500 LET C0 = F*K + E*L + G*J + I*H
1510 LET T6 = FNR(C9,C0)
1520 REM  COMPUTE WEIGHTS FOR 2ND ORDER COEFFICIENTS
1530 LET U(1)=X1+X2
1540 LET U(2)=X3+X4
1550 LET U(3)=C2*C3+C1*C4
1560 LET U(4)=R1*R4+R2*R3
1570 LET U(5)=X5+X6
1580 LET U(6)=X7+X8
1590 LET W(1)=A1+A2
1600 LET W(2)=B1+B2
1610 LET W(3)=B3+B4
1620 LET W(4)=K1+K2
1630 LET W(5)=A3+A4
1640 LET W(6)=D1+D2
1650 LET W(7)=D3+D4
1660 LET W(8)=K3+K4
1670 LET W(9)=A5+A6
1680 LET W(10)=E1+E2
1690 LET W(11)=E3+E4
1700 LET W(12)=K5+K6
1710 LET W(13)=A7+A8
1720 LET W(14)=F1+F2
1730 LET W(15)=F3+F4
1740 LET W(16)=K7+K8
1750 LET W(17)=A9+A0
1760 LET W(18)=G1+G2
1770 LET W(19)=G3+G4
1780 LET W(20)=K9+K0
1790 LET W(21)=C7+C8
1800 LET W(22)=H1+H2
1810 LET W(23)=H3+H4
1820 LET W(24)=C9+C0
1830 FOR W1=1 TO 24
1840 LET W2=INT((W1-1)/4)+1
1850 LET W(W1)=W(W1)/U(W2)
1860 NEXT W1
1870 REM COMPUTE THE 1ST ORDER Q'S BY WEIGHTED SUMS OF 2ND ORDER Q'S
1880 LET Q(1)  = (B8*W(2) + S1*W(1)) / (W(1) + W(2))
1890 LET Q(2)  = (T1*W(4) + B9*W(3)) / (W(4) + W(3))
1900 LET Q(3)  = (S1*W(1) + B9*W(3)) / (W(1) + W(3))
1910 LET Q(4)  = (B8*W(2) + T1*W(4)) / (W(2) + W(4))
1920 LET Q(5)  = (D8*W(6) + S2*W(5)) / (W(6) + W(5))
1930 LET Q(6)  = (T2*W(8) + D9*W(7)) / (W(8) + W(7))
1940 LET Q(7)  = (S2*W(5) + D9*W(7)) / (W(5) + W(7))
1950 LET Q(8)  = (D8*W(6) + T2*W(8)) / (W(6) + W(8))
1960 LET Q(9)  = (E8*W(10)+ S3*W(9)) / (W(10)+ W(9))
1970 LET Q(10) = (T3*W(12)+E9*W(11)) / (W(12)+W(11))
1980 LET Q(11) = (S3*W(9) +E9*W(11)) / (W(9) +W(11))
1990 LET Q(12) = (E8*W(10)+T3*W(12)) / (W(10)+W(12))
2000 LET Q(13) = (F8*W(14)+S4*W(13)) / (W(14)+W(13))
2010 LET Q(14) = (T4*W(16)+F9*W(15)) / (W(16)+W(15))
2020 LET Q(15) = (S4*W(13)+F9*W(15)) / (W(13)+W(15))
2030 LET Q(16) = (F8*W(14)+T4*W(16)) / (W(14)+W(16))
2040 LET Q(17) = (G8*W(18)+S5*W(17)) / (W(18)+W(17))
2050 LET Q(18) = (T5*W(20)+G9*W(19)) / (W(20)+W(19))
2060 LET Q(19) = (S5*W(17)+G9*W(19)) / (W(17)+W(19))
2070 LET Q(20) = (G8*W(18)+T5*W(20)) / (W(18)+W(20))
2080 LET Q(21) = (H8*W(22)+S6*W(21)) / (W(22)+W(21))
2090 LET Q(22) = (T6*W(24)+H9*W(23)) / (W(24)+W(23))
2100 LET Q(23) = (S6*W(21)+H9*W(23)) / (W(21)+W(23))
2110 LET Q(24) = (H8*W(22)+T6*W(24)) / (W(22)+W(24))
2120 PRINT L$;L$;L$;L$;TAB(25);"DECOMPOSITION OF Q"
2130 PRINT
2140 PRINT
2150PRINTTAB(6);"ZERO ORDER, 3-VARIABLE, & 4-VARIABLE COEFFICIENTS"
2160 PRINT L$;L$;"RELATIONSHIP";TAB(25);"DIFF : ";T$;" : TIED";TAB(48);
2170 PRINT "1ST ORDER"
2180 GOSUB 2970
2190 PRINT X$;"\"
2200 PRINT Y$;"/";TAB(17);"/TIED *";TAB(27);FNP(B8);TAB(38);FNP(S1);
2210 PRINT TAB(46);"*";TAB(50);FNP(Q(1))
2220 PRINT TAB(11);S$;L$;"\DIFF *";TAB(27);FNP(T1);TAB(38);FNP(B9);
2230 PRINT TAB(46);"*";TAB(50);FNP(Q(2))
2240 GOSUB 3000
2250 PRINT TAB(13);"1ST ORDER *";TAB(27);FNP(Q(4));TAB(38);FNP(Q(3));
2260 PRINT TAB(46);"*"; TAB(50); FNP(Q1)
2270 PRINT L$;L$;L$
2280 PRINT "RELATIONSHIP";TAB(25);"DIFF : ";X$;" : TIED";TAB(48);
2290 PRINT "1ST ORDER"
2300 GOSUB 2970
2310 PRINT T$;"\"
2320 PRINT Y$;"/";TAB(17);"/TIED *";TAB(27);FNP(D8);TAB(38);FNP(S2);
2330 PRINT TAB(46);"*";TAB(50);FNP(Q(5))
2340 PRINT TAB(11);S$;L$;"\DIFF *";TAB(27);FNP(T2);TAB(38);FNP(D9);
2350 PRINT TAB(46); "*";TAB(50); FNP(Q(6))
2360 GOSUB 3000
2370 PRINT TAB(13);"1ST ORDER *";TAB(27);FNP(Q(8));TAB(38);FNP(Q(7));
2380 PRINT TAB(46);"*";TAB(50);FNP(Q2)
2390 PRINT L$;L$;L$
2400 PRINT "RELATIONSHIP";TAB(25);"DIFF : ";X$;" : TIED";TAB(48);
2410 PRINT "1ST ORDER"
2420 GOSUB 2970
2430 PRINT S$;"\"
2440 PRINT Y$;"/";TAB(17);"/TIED *";TAB(27);FNP(E8);TAB(38);FNP(S3);
2450 PRINT TAB(46); "*"; TAB(50); FNP(Q(9))
2460 PRINT TAB(11);T$;L$;"\DIFF *";TAB(27);FNP(T3);TAB(38);FNP(E9);
2470 PRINT TAB(46); "*"; TAB(50); FNP(Q(10))
2480 GOSUB 3000
2490 PRINT TAB(13);"1ST ORDER *";TAB(27);FNP(Q(12));TAB(38);FNP(Q(11));
2500 PRINT TAB(46);"*";TAB(50);FNP(Q3)
2510 PRINT L$;L$;L$
2520 PRINT "RELATIONSHIP";TAB(25);"DIFF : ";Y$;" : TIED";TAB(48);
2530 PRINT "1ST ORDER"
2540 GOSUB 2970
2550 PRINT T$;"\"
2560 PRINT X$;"/";TAB(17);"/TIED *";TAB(27);FNP(F8);TAB(38);FNP(S4);
2570 PRINT TAB(46); "*"; TAB(50); FNP(Q(13))
2580 PRINT TAB(11);S$;L$;"\DIFF *";TAB(27);FNP(T4);TAB(38);FNP(F9);
2590 PRINT TAB(46); "*";TAB(50); FNP(Q(14))
2600 GOSUB 3000
2610 PRINT TAB(13);"1ST ORDER *";TAB(27);FNP(Q(16));TAB(38);FNP(Q(15));
2620 PRINT TAB(46);"*";TAB(50);FNP(Q4)
2630 PRINT L$;L$;L$
2640 PRINT "RELATIONSHIP";TAB(25);"DIFF : ";Y$;" : TIED";TAB(48);
2650 PRINT "1ST ORDER"
2660 GOSUB 2970
2670 PRINT S$;"\"
2680 PRINT X$;"/";TAB(17);"/TIED *";TAB(27);FNP(G8);TAB(38);FNP(S5);
2690 PRINT TAB(46); "*"; TAB(50); FNP(Q(17))
2700 PRINT TAB(11);T$;L$;"\DIFF *";TAB(27);FNP(T5);TAB(38);FNP(G9);
2710 PRINT TAB(46);"*";TAB(50); FNP(Q(18))
2720 GOSUB 3000
2730 PRINT TAB(13); "1ST ORDER *";TAB(27);FNP(Q(20));TAB(38);FNP(Q(19));
2740 PRINT TAB(46);"*";TAB(50);FNP(Q5)
2750 PRINT L$;L$;L$
2760 PRINT "RELATIONSHIP";TAB(25);"DIFF : ";Y$;" : TIED";TAB(48);
2770 PRINT "1ST ORDER"
2780 GOSUB 2970
2790 PRINT S$;"\"
2800 PRINT T$;"/";TAB(17);"/TIED *";TAB(27);FNP(H8);TAB(38);FNP(S6);
2810 PRINT TAB(46);"*"; TAB(50);FNP(Q(21))
2820 PRINT TAB(11);X$;L$;"\DIFF *";TAB(27);FNP(T6);TAB(38);FNP(H9);
2830 PRINT TAB(46); "*"; TAB(50);FNP(Q(22))
2840 GOSUB 3000
2850 PRINT TAB(13);"1ST ORDER *";TAB(27);FNP(Q(24));TAB(38);FNP(Q(23));
2860 PRINT TAB(46);"*";TAB(50);FNP(Q6)
2870 PRINT L$;L$;L$
2880 PRINT"==============================================================="
2890 PRINT L$;L$; L$;L$; "DO YOU WANT TO ENTER ANOTHER ROUND OF DATA ";
2900 PRINT "(YES OR NO)";
2910 INPUT Z$
2920 IF Z$ = "YES" THEN 500
2930 IF Z$ = "NO" THEN 2960
2940 PRINT "ONE LAST CHANCE TO ANSWER YES BEFORE I GO HOME."
2950 GO TO 2910
2960 STOP
2970 PRINT "============";TAB(25);"====================";TAB(48);
2980 PRINT "========="
2990 RETURN
3000 PRINT TAB(25); "--------------------"; TAB(48); "---------"
3010 RETURN
3020 REM RAW DATA TABLE PRINT-OUT
3030 PRINT
3040 PRINT
3050 PRINT
3060 PRINT TAB(30);"RAW DATA"
3070 PRINT
3080PRINT TAB(20);"Y";TAB(50);"Y"
3090 PRINTTAB(15);"----------";TAB(45);"----------"
3100 PRINT "  S  T  X  :    -     +      :  S  T  X  :    -      +"
3110 PRINT "----------------------------------------------------"
3120 PRINT "  +  +  +  :";TAB(14);A;TAB(20);B;TAB(30);"  -  +  +  :";
3130 PRINT TAB(44);I;TAB(50);J
3140 PRINT "  +  +  -  :";TAB(14);C;TAB(20);D;TAB(30);
3150 PRINT "  -  +  -  :";TAB(44);K;TAB(50);L
3160 PRINT "  +  -  +  :";TAB(14);E;TAB(20);F;TAB(30);"  -  -  +  :";
3170 PRINTTAB(44);M;TAB(50);N
3180 PRINT "  +  -  -  :";TAB(14);G;TAB(20);H;TAB(30);"  -  -  -  :";
3190 PRINT TAB(44);O;TAB(50);P
3200 PRINT
3210 PRINT TAB(45);"N = ";Q
3220 PRINT
3230 PRINT
3240 PRINT "IS THIS TABLE CORRECT";
3250 INPUT Z$
3260 IF Z$ = "YES" THEN 630
3270 IF Z$ = "NO" THEN 3300
3280 PRINT "A SIMPLE YES OR NO WILL DO JUST FINE";
3290 GO TO 3250
3300 PRINT "THEN HAVE FUN TYPING IN THE NEW TABLE"
3310 GO TO 500
3320 PRINT "EXECUTION TERMINATED BY N = 0."
3330 STOP
3340 END