Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0113/cmod89.bas
There are 2 other files named cmod89.bas in the archive. Click here to see a list.
00020REM *********************************************************************
00030REM CMOD89 CMOD89 CMOD89 CMOD89 CMOD89 CMOD89 CMOD89
00040REM
00050REM SET UP FOR 3X3 ANOVA
00060REM
00070REM******************************************************************
00080DATA 1,1,1,-1,-1,-1,0,0,0
00090DATA 0,0,0,-1,-1,-1,1,1,1
00100DATA 1,-1,0,1,-1,0,1,-1,0
00110DATA 0,-1,1,0,-1,1,0,-1,1
00120DATA 1,-1,0,-1,1,0,0,0,0
00130DATA 0,-1,1,0,1,-1,0,0,0
00140DATA 0,0,0,-1,1,0,1,-1,0
00150DATA 0,0,0,0,1,-1,0,-1,1
00160DATA 1,1,1,1,1,1,1,1,1
00170Q6=0
00180W9=0
00190 FILES RFILE1,RFILE2,RFILE3,,,,RF7,,RF9
00230RESTORE#1
00231 INPUT# 1,I1,I2,I3
00240SCRATCH#1
00241 PRINT # 1,89,I2,I3
00250S8=0
00260SCRATCH#3
00261 PRINT # 3,0
00270RESTORE#2
00271 INPUT# 2,G0
00280IF G0=0 THEN 410
00290MAT N=ZER(G0)
00300MAT O=ZER(G0,1)
00310MAT S=ZER(G0,1)
00320 FORI=1 TO G0
00321INPUT#2,N(I)
00322NEXTI
00323FOR I=1 TO G0
00324INPUT#2,O(I,1)
00325 NEXT I
00326 FOR I=1 TO G0
00327 INPUT #2,S(I,1)
00328 NEXT I
00330G5=0
00340MAT X=ZER(G0,G0)
00350FOR I=1 TO G0
00360G5=G5+N(I)-1
00370S8=S8+S(I,1)*N(I)*S(I,1)
00380X(I,I)=1/N(I)
00390NEXT I
00400GOTO 1410
00410G0=9
00420S8=0
00430 DIM X(12,12),A(12,12),B(12,12),C(12,12),D(12,12),E(12,12)
00440 DIM P(12,12),Q(1,12),R(12,1),S(12,1),T(12,12),U(12,12)
00450 DIM O(12,1),K(12,1),H(12),V(12),F(12,12),G(12,12),I(12),J(12,12)
00460 DIM Z(12,1),M(12,12),L(12,12)
00480 W$="111213212223313233"
00490MAT O=CON(G0,1)
00500 DIM N(12)
00510MAT X=CON(G0,G0)
00520MAT S=ZER(G0,1)
00530MAT N=ZER(G0)
00540MAT X=ZER
00550PRINT L$
00560PRINT " THREE BY THREE"
00570PRINT
00580PRINT "HERE IS THE TERMINOLOGY FOR THE DESIGN."
00590PRINT
00600PRINT " COLUMN 1 COLUMN 2 COLUMN 3"
00610PRINT
00620PRINT " ROW 1 CELL 11 CELL 12 CELL 13"
00630PRINT
00640PRINT " ROW 2 CELL 21 CELL 22 CELL 23"
00650PRINT
00660PRINT " ROW 3 CELL 31 CELL 32 CELL 33"
00670PRINT " "
00680PRINT "FOR EACH CELL YOU WILL BE ASKED TO ENTER THE MEAN,"
00690PRINT "SAMPLE SIZE, AND STANDARD DEVIATION. IF YOU DO NOT HAVE"
00700PRINT "THESE STATISTICS FOR YOUR DATA THEY MAY BE OBTAINED IN"
00710PRINT "COMPONENT 1."
00720PRINT " "
00730PRINT "IF YOU HAVE YOUR STATISTICS AND WISH TO CONTINUE TYPE '1'."
00740PRINT " OTHERWISE TYPE '0'";
00750GOSUB 9000
00760IF O1 <> 0 THEN 780
00770CHAIN "RSTRT"
00780G0=9
00790G5=0
00800PRINT L$
00810FOR I=1 TO G0
00820IF I>3 THEN 850
00830PRINT "CELL";10+I;
00840GOTO 890
00850IF I>6 THEN 880
00860PRINT "CELL";17+I;
00870GOTO 890
00880PRINT "CELL";24+I;
00890PRINT "SAMPLE SIZE, MEAN, ST.DEV.(DIVISOR N)";
00900GOSUB 9100
00910IF O3>0 THEN 940
00920PRINT "REENTER. ST. DEV. MUST BE GREATER THAN 0."
00930GOTO 900
00940IF O1 >= 2 THEN 970
00950PRINT "REENTER. SAMPLE SIZE MUST BE AT LEAST 2."
00960GOTO 900
00970O(I,1)=O2
00980X(I,I)=1/O1
00990N(I)=O1
01000S(I,1)=O3
01010G5=G5+O1-1
01020S8=S8+O3*O1
01030IF Q6=1 THEN 1050
01040NEXT I
01050PRINT L$
01060Q6=0
01070PRINT "CELL SAMPLE SIZE MEAN ST. DEV."
01080PRINT " "
01090FOR I=1 TO G0
01100:'C ### ###.## ###.##
01110PRINT USING 1100,MID$(W$,(I-1)*2+1,2),N(I),O(I,1),S(I,1)
01120NEXT I
01130PRINT
01140PRINT "TO CONTINUE TYPE '1'"
01150PRINT "TO RESPECIFY INDIVIDUAL CELL TYPE ITS NUMBER"
01160PRINT "TO RESPECIFY ALL CELLS TYPE '0'";
01170GOSUB 9002
01180O1=INT(O1)
01190IF O1=1 THEN 1360
01200IF O1=0 THEN 800
01210IF O1<11 THEN 1340
01220Q6=1
01230I=O1-10
01240IF I <= 0 THEN 1340
01250IF I <= 3 THEN 830
01260I=I-7
01270IF I <= 3 THEN 1340
01280IF I>6 THEN 1300
01290GOTO 850
01300I=I-7
01310IF I <= 6 THEN 1340
01320IF I>9 THEN 1340
01330GOTO 850
01340PRINT "INPUT MUST BE '0', OR CELL NUMBER"
01350GOTO 1070
01360SCRATCH#2
01361 PRINT # 2,G0
01362 FOR I=1 TO G0
01363 PRINT#2,N(I)
01364NEXT I
01365FOR I=1 TO G0
01366PRINT#2,O(I,1)
01367NEXT I
01368FOR I=1 TO G0
01369 PRINT#2,S(I,1)
01370 NEXT I
01380SCRATCH#7
01381PRINT#7,0
01382PRINT#7,0
01383PRINT#7,0
01384PRINT#7,0
01390CHAIN "CMOD89"
01400PRINT
01410C5=0
01420PRINT L$
01430G2=G5
01440S9=S8/G2
01450GOSUB 1470
01460GOTO 1690
01470PRINT "POSTERIOR DISTRIBUTION OF THE 9 CELL PARAMETERS IS MULTIVARIATE T"
01480PRINT "WITH ";G2;" DEGREES OF FREEDOM AND WITH THE FOLLOWING MARGINAL"
01490PRINT "UNIVARIATE T DISTRIBUTIONS:"
01500PRINT
01510PRINT " DF MEAN ST. DEV."
01520K0=0
01530FOR I=1 TO 3
01540FOR J=1 TO 3
01550:CELL## ## ### ########.## ########.##
01560K0=K0+1
01570IF C5=0 THEN 1650
01580FOR I0=1 TO C5
01590IF H(I0)=K0 THEN 1620
01600NEXT I0
01610GOTO 1650
01620:CELL## ## GIVEN ########.##
01630PRINT USING 1620,I,J,V(I0)
01640GOTO 1660
01650PRINT USING 1550,I,J,G2,O(K0,1),SQR(S8*X(K0,K0)/(G2-2))
01660NEXT J
01670NEXT I
01680RETURN
01690PRINT
01700PRINT "THE ANALYSIS CAN NOW BE CONDUCTED USING ONE"
01710PRINT "OF THE FOLLOWING PARAMETERIZATIONS."
01720PRINT " "
01730PRINT " 1. CELL PARAMETERIZATION"
01740PRINT " 2. ANOVA EFFECTS"
01750PRINT " 3. USER SPECIFIED EFFECTS"
01760PRINT "TYPE THE NUMBER OF THE OPTION YOU WISH OR '0' TO EXIT.";
01770GOSUB 9000
01780T8=O1
01790D5=G0
01800IF O1=3 THEN 1860
01810IF O1=1 THEN 2400
01820IF O1=2 THEN 2400
01830IF O1=0 THEN 770
01840PRINT "REENTER. INPUT MUST BE NUMBER OF AVAILABLE OPTION."
01850GOTO 1770
01860PRINT "THIS ANALYSIS WILL BE BASED ON A SET OF NEW PARAMETERS DEFINED"
01870PRINT "AS INDEPENDENT LINEAR COMBINATIONS OF THE ORIGINAL 9 PARAMETERS."
01880PRINT "FOR EACH OF THESE NEW PARAMETERS YOU WILL NEED TO SPECIFY THE"
01890PRINT "9 COEFFICIENTS OF THE ORIGINAL 9 PARAMETERS."
01900PRINT
01910PRINT "ENTER NUMBER OF LINEAR COMBINATIONS(MAX=9).";
01920GOSUB 9000
01930IF O1<1 THEN 1960
01940IF O1>9 THEN 1960
01950GOTO 1980
01960PRINT "NUMBER OF LINEAR COMBINATIONS MUST BE BETWEEN 1 AND 9."
01970GOTO 1910
01980C5=0
01990D5=INT(O1)
02000PRINT
02010PRINT
02020MAT D=ZER(D5,G0)
02030PRINT " "
02040FOR I=1 TO D5
02050PRINT "COEFFICIENTS FOR CELLS - 11,12,13,21,22,23,31,32,33 ";
02060INPUT D(I,1),D(I,2),D(I,3),D(I,4),D(I,5),D(I,6),D(I,7),D(I,8),D(I,9)
02070NEXT I
02080MAT L=ZER(D5,G0)
02090MAT L=D
02100R0=D5
02110C0=G0
02120GOSUB 9700
02130PRINT L$
02140GOTO 2180
02150PRINT "THE PARAMETERS TO BE STUDIED HAVE BEEN FORMED BY THE FOLLOWING"
02160PRINT "LINEAR COMBINATIONS OF CELL MEANS."
02170RETURN
02180GOSUB 2150
02190GOSUB 2210
02200GOTO 2300
02210PRINT "CELL 11 12 13 21 22 23 31 32 33"
02220PRINT " "
02230FOR I=1 TO D5
02232 SCRATCH#9
02234 QUOTE#9
02240:"PRM## ###.## ###.## ###.## ###.## ###.## ###.##"
02241 PRINT#9USING2240,I,D(I,1),D(I,2),D(I,3),D(I,4),D(I,5),D(I,6)
02242 RESTORE#9
02245 INPUT#9,D$
02250PRINT D$;
02255 SCRATCH#9
02260:" ###.## ###.## ###.##"
02270PRINT#9USING 2260,D(I,7),D(I,8),D(I,9)
02272RESTORE#9
02274INPUT#9,D$
02276PRINTD$
02280NEXT I
02290RETURN
02300W9=1
02310PRINT "TO CONTINUE TYPE '1'"
02320PRINT "TO RESPECIFY TYPE '0'.";
02330GOSUB 9002
02340IF O1=0 THEN 1910
02350IF L0=1 THEN 2390
02360PRINT " "
02370PRINT "YOUR LINEAR COMBINATIONS ARE DEPENDENT, RESPECIFY."
02380GOTO 1910
02390GOTO 2430
02400D5=G0
02410SCRATCH#3
02411 PRINT # 3,0
02420MAT D=CON(D5,G0)
02430MAT A=CON(D5,G0)
02440MAT B=CON(G0,D5)
02450MAT C=CON(D5,D5)
02460MAT E=CON(D5,D5)
02470MAT M=CON(G0,G0)
02480MAT M=X
02490IF T8=3 THEN 2850
02500IF T8=2 THEN 2630
02510MAT D=IDN(G0,G0)
02520PRINT L$
02530PRINT "PARAMETER 1 = MEAN CELL 11"
02540PRINT "PARAMETER 2 = MEAN CELL 12"
02550PRINT "PARAMETER 3 = MEAN CELL 13"
02560PRINT "PARAMETER 4 = MEAN CELL 21"
02570PRINT "PARAMETER 5 = MEAN CELL 22"
02580PRINT "PARAMETER 6 = MEAN CELL 23"
02590PRINT "PARAMETER 7 = MEAN CELL 31"
02600PRINT "PARAMETER 8 = MEAN CELL 32"
02610PRINT "PARAMETER 9 = MEAN CELL 33"
02620GOTO 2850
02630MAT D=CON(G0,G0)
02640PRINT L$
02650MAT READ D
02660FOR I=1 TO 4
02670FOR J=1 TO 9
02680D(I,J)=D(I,J)/3
02690NEXT J
02700NEXT I
02710FOR I=1 TO 9
02720D(9,I)=D(9,I)/9
02730NEXT I
02740GOSUB 2150
02750GOSUB 2210
02760PRINT "PARAMETER 1 = ROW EFFECT BETWEEN ROWS 1 AND 2."
02770PRINT "PARAMETER 2 = ROW EFFECT BETWEEN ROWS 2 AND 3."
02780PRINT "PARAMETER 3 = COLUMN EFFECT BETWEEN COLUMNS 1 AND 2."
02790PRINT "PARAMETER 4 = COLUMN EFFECT BETWEEN COLUMNS 2 AND 3."
02800PRINT "PARAMETER 5 = LOCAL INTERACTION EFFECT IN UPPER LEFT CORNER."
02810PRINT "PARAMETER 6 = LOCAL INTERACTION EFFECT IN UPPER RIGHT CORNER."
02820PRINT "PARAMETER 7 = LOCAL INTERACTION EFFECT IN LOWER LEFT CORNER."
02830PRINT "PARAMETER 8 = LOCAL INTERACTION EFFECT IN LOWER RIGHT CORNER."
02840PRINT "PARAMETER 9 = OVERALL MEAN EFFECT."
02850SCRATCH#7
02851PRINT#7,G0
02852PRINT#7,S8
02853PRINT#7,G5
02854PRINT#7,D5
02860MAT M=ZER(D5,1)
02861FORI=1TOG0
02862PRINT#7,N(I)
02863NEXT I
02864FOR I=1 TO G0
02865PRINT#7,O(I,1)
02866NEXT I
02867FORI=1TOD5
02868FORJ=1TOG0
02869PRINT#7,D(I,J)
02870NEXTJ
02871NEXTI
02872 FOR I=1 TO D5*2
02873PRINT#7,1
02874NEXT I
02880IF W9=1 THEN 2920
02890PRINT " "
02900PRINT "TO CONTINUE TYPE '1'.";
02910GOSUB 9002
02920CHAIN "CMOD70"
09000REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
09002REM
09005INPUT O1
09015IF O1=-9999 THEN 9025
09020RETURN
09025CHAIN "RSTRT"
09035REM*************END ROUTINE
09050REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED. 2 INPUTS
09055INPUT O1,O2
09065IF O1=-9999 THEN 9080
09070IF O2=-9999 THEN 9080
09075RETURN
09080CHAIN "RSTRT"
09090REM*************END ROUTINE
09100REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED. 3 INPUTS
09105INPUT O1,O2,O3
09115IF O1=-9999 THEN 9135
09120IF O2=-9999 THEN 9135
09125IF O3=-9999 THEN 9135
09130RETURN
09135CHAIN "RSTRT"
09145REM*************END ROUTINE
09700REM SUBROUTINE DETERMINES IF MATRIX L HAS INDEPENDENT ROWS
09702REM L HAS R0 ROWS AND C0 COLUMNS
09704REM R0 MUST BE <= C0
09706REM RETURNS L0=0 IF DEPENDENT L0=1 IF INDEPENDENT
09708L0=0
09710FOR K=1 TO R0
09712FOR L2=1 TO C0
09714FOR K1=K TO R0
09716IF L(K1,L2) <> 0 THEN 9724
09718NEXT K1
09720NEXT L2
09722GOTO 9770
09724IF K1=1 THEN 9736
09726FOR I=1 TO C0
09728L9=L(K1,I)
09730L(K1,I)=L(K,I)
09732L(K,I)=L9
09734NEXT I
09736L9=L(K,L2)
09738FOR I=1 TO C0
09740L(K,I)=L(K,I)/L9
09742NEXT I
09744FOR J=K+1 TO R0
09746IF L(J,L2)=0 THEN 9756
09748L9=L(J,L2)
09750FOR I=1 TO C0
09752L(J,I)=-L(J,I)/L9+L(K,I)
09754NEXT I
09756NEXT J
09758NEXT K
09760FOR I=1 TO C0
09762IF L(R0,I) <> 0 THEN 9768
09764NEXT I
09766GOTO 9770
09768L0=1
09770RETURN
09772REM***********END OF ROUTINE*********************************
09999END