Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0113/cmod62.bas
There are 2 other files named cmod62.bas in the archive. Click here to see a list.
00015C1=1
00020REM CMOD62
00022 MARGIN ALL 80
00030 DIM A(10),B(4),Z(4,250),V(4,4),W(4,4),T(4,1),Q(250),F(4,4)
00040 DIM Y(250),N(12),X(250,4),C(4,1),D(10),E(10,4)
00050 DIM G(10,10),M(10,1),H(10,10),U(10,10),K(10,10),L(4),I(4,4),J(5)
00060D0=0
00065O9=C1
00110 FILES RFILE1,RFILE2,RFILE3,RF4
00150RESTORE#1
00151 INPUT# 1,I1,I2,I3
00160SCRATCH#1
00161 PRINT # 1,62,I2,I3
00170RESTORE#4
00171 INPUT# 4,N$
00340 INPUT #4,M
00345 INPUT#4,P
00350PRINT L$
00430PRINT " DATA SET --";N$
00440PRINT " "
00450PRINT M;" GROUPS"
00470 INPUT#4,G$
00480 INPUT#4,V$
00490FOR I1=C1 TO M
00500 PRINT "GROUP";I1;"--";MID$(G$,(I1-1)*6+1,(I1-1)*6+6-((I1-1)*6+1)+1)
00510NEXT I1
00520PRINT " "
00530PRINT P;"VARIABLES"
00550FOR I1=C1 TO P
00560 PRINT "VARIABLE";I1;"--";MID$(V$,(I1-1)*6+1,(I1-1)*6+6-((I1-1)*6+1)+1)
00570NEXT I1
00580PRINT "25 OBSERVATIONS WILL BE SELECTED FROM EACH GROUP."
00581PRINT "TO CONTINUE TYPE '1' ELSE TYPE '0' AND REGROUP IN COMP1";
00583GOSUB 9000
00585IF O1=C1 THEN 590
00586CHAIN "RSTRT"
00590PRINT "TYPE THE NUMBER OF THE CRITERION VARIABLE.";
00600GOSUB 9000
00610C0=INT(O1)
00620IF C0<1 THEN 650
00630IF C0>P THEN 650
00640GOTO 730
00650PRINT "NOT VALID NUMBER. RESPECIFY"
00660GOTO 600
00730FORI=1TO12
00731 INPUT #4,N(I)
00732NEXTI
00740S0=0
00750FOR I=C1 TO M
00760IF N(I) <= 25 THEN 790
00770S0=S0+25
00780GOTO 800
00790S0=S0+N(I)
00800NEXT I
00810MAT Y=ZER(S0)
00820I5=0
00830S3=0
00840MAT J=ZER
00850FOR I1=C1 TO P
00860IF C0=I1 THEN 930
00865O1=(I1-1)*6+1
00870 PRINT "IF YOU WANT ";MID$(V$,O1,O1+5-(O1)+1);" AS A PREDICTOR,"
00880PRINT "TYPE '1' ELSE TYPE '0'";
00890GOSUB 9000
00900IF O1 <> 1 THEN 930
00910J(I1)=C1
00920I5=I5+1
00930NEXT I1
00940IF I5>0 THEN 990
00950PRINT
00960PRINT "MUST HAVE AT LEAST 1 PREDICTOR"
00970PRINT
00980GOTO 820
00990PRINT L$
01000PRINT "COMPUTING LEAST SQUARES ESTIMATES"
01010S3=0
01020MAT X=ZER(S0,I5)
01030FOR I2=C1 TO M
01040I6=0
01050FOR I1=C1 TO P
01060IF J(I1) <> 1 THEN 1080
01070I6=I6+1
01080FOR I3=C1 TO N(I2)
01090 INPUT#4,I4
01100IF I3>25 THEN 1160
01110IF I1 <> C0 THEN 1140
01120Y(S3+I3)=I4
01130GOTO 1160
01140IF J(I1) <> 1 THEN 1160
01150X(S3+I3,I6)=I4
01160NEXT I3
01170NEXT I1
01180IF N(I2) <= 25 THEN 1200
01190N(I2)=25
01200S3=S3+N(I2)
01210NEXT I2
01220P=I5
01230S0=S3
01240S=0
01250S1=0
01260MAT A=ZER(M)
01270FOR I=C1 TO M
01280FOR J=C1 TO N(I)
01290A(I)=A(I)+Y(S+J)
01300NEXT J
01310S=S+N(I)
01320A(I)=A(I)/N(I)
01330S1=A(I)+S1
01340NEXT I
01350S1=S1/M
01360MAT Z=ZER(P,S0)
01370S9=0
01380MAT M=ZER(M,1)
01390FOR I=C1 TO M
01400FOR J=C1 TO N(I)
01410M(I,1)=M(I,1)+Y(S9+J)
01420FOR K=C1 TO P
01430Z(K,S9+J)=Z(K,S9+J)-X(S9+J,K)/S0
01440NEXT K
01450NEXT J
01460FOR J=C1 TO N(I)
01470FOR K=C1 TO P
01480Z(K,S9+J)=X(S9+J,K)+Z(K,S9+J)
01490NEXT K
01500NEXT J
01510S9=S9+N(I)
01520NEXT I
01530MAT X=TRN(Z)
01540MAT W=ZER(P,P)
01550MAT W=Z*X
01560MAT V=ZER(P,P)
01570MAT V=INV(W)
01580MAT B=ZER(P)
01590MAT C=ZER(P,1)
01600MAT C=Z*Y
01610MAT B=V*C
01620MAT Q=ZER(S0)
01630MAT Q=X*B
01640P0=0
01650S3=0
01660FOR I=C1 TO M
01670FOR J=C1 TO N(I)
01680P0=P0+(Y(S3+J)-A(I)-Q(J))**2
01690NEXT J
01700S3=S3+N(I)
01710NEXT I
01720P0=P0/(S0-P-M)
01730N0=0
01740FOR I=C1 TO M
01750N0=N0+1/N(I)
01760NEXT I
01770P1=0
01780FOR I=C1 TO M
01790P1=P1+(A(I)-S1)*(A(I)-S1)
01800NEXT I
01810P1=P1/(M-1)-P0/M*N0
01820IF D0=0 THEN 1840
01830RETURN
01840PRINT L$
01850D0=0
01860PRINT " LEAST SQUARE ESTIMATES"
01870PRINT " "
01880PRINT "STANDARD DEVIATION OF RESIDUALS ";SQR(P0)
01890IF D0=0 THEN 1910
01900PRINT "STANDARD DEVIATION OF INTERCEPT AT GRAND MEAN ";SQR(P1)
01910PRINT " "
01920PRINT " INTERCEPT AT GRAND MEAN"
01930FOR I=C1 TO M
01940 PRINT MID$(G$,6*(I-1)+1,6*(I-1)+6-(6*(I-1)+1)+1);" ";A(I)
01950NEXT I
01960PRINT " "
01970PRINT " REGRESSION COEFFICIENTS"
01980J=0
01990FOR I=C1 TO 5
02000IF J(I) <> 1 THEN 2030
02010J=J+1
02015O1=6*(I-1)+1
02020 PRINT MID$(V$,O1,O1+5-(O1)+1);" ";B(J)
02030NEXT I
02040IF D0 <> 0 THEN 2130
02050D0=0
02060PRINT "INPUT MOST PROBABLE VALUE OF THE STANDARD DEVIATION OF"
02070PRINT "THE INTERCEPTS AT THE GRAND MEAN."
02080GOSUB 9000
02090P1=O1
02100IF P1>0 THEN 2170
02110PRINT "STD. DEV. MUST BE > ZER0. RESPECIFY."
02120GOTO 2080
02130PRINT "IF YOU WISH TO RESPECIFY THE STD. DEV. OF INTERCEPTS,"
02140PRINT "TYPE '1'. ELSE TYPE '0'.";
02150GOSUB 9000
02160IF O1=C1 THEN 2050
02170P1=P1*P1
02180IF D0 <> 0 THEN 3185
02190PRINT L$
02200PRINT "COMPUTING BAYESIAN ESTIMATES"
02210L0=3*P0
02220L1=3*P1
02230MAT U=IDN(M,M)
02240MAT K=IDN(M,M)
02250FOR I=C1 TO M
02260U(I,I)=N(I)+P0/P1*(1-1/M)
02270FOR J=C1 TO M
02280IF J=I THEN 2300
02290U(I,J)=-P0/P1/M
02300NEXT J
02310NEXT I
02320MAT K=INV(U)
02330MAT F=ZER(P,P)
02340MAT L=ZER(P)
02350MAT E=ZER(M,P)
02360S3=0
02370FOR I=C1 TO M
02380FOR J=C1 TO N(I)
02390FOR K=C1 TO P
02400E(I,K)=E(I,K)+X(S3+J,K)
02410NEXT K
02420NEXT J
02430S3=S3+N(I)
02440NEXT I
02450FOR I=C1 TO P
02460FOR J=C1 TO P
02470Z1=0
02480M1=0
02490FOR K0=C1 TO M
02500FOR L=C1 TO M
02510Z1=Z1+K(L,K0)*E(L,I)
02520NEXT L
02530FOR K1=C1 TO N(K0)
02540IF J <> 1 THEN 2560
02550L(I)=L(I)+(X(K1+M1,I)-Z1)*Y(K1+M1)
02560F(I,J)=F(I,J)+(X(K1+M1,I)-Z1)*X(K1+M1,J)
02570NEXT K1
02580M1=M1+N(K0)
02590NEXT K0
02600NEXT J
02610NEXT I
02640MAT I=IDN(P,P)
02650MAT I=INV(F)
02660MAT B=ZER(P)
02670MAT B=I*L
02680GOTO 2740
02690FOR I=C1 TO P
02700FOR K=C1 TO P
02710B(I)=B(I)+I(I,K)*L(K)
02720NEXT K
02730NEXT I
02740REM
02750MAT Q=X*B
02760S3=0
02770MAT D=ZER(M)
02780FOR I=C1 TO M
02790FOR J=C1 TO N(I)
02800D(I)=D(I)+Q(J+S3)
02810NEXT J
02820S3=S3+N(I)
02830NEXT I
02840MAT A=ZER(M)
02850FOR I=C1 TO M
02860FOR K=C1 TO M
02870A(I)=A(I)+K(I,K)*(M(K,1))
02880NEXT K
02890NEXT I
02900P2=P0
02910P3=P1
02920GOTO 2990
02930IF ABS(P0-P2)>.01*P0 THEN 2230
02940IF ABS(P1-P3)>.01*P1 THEN 2230
02950PRINT L$
02960PRINT " BAYESIAN ESTIMATES"
02970D0=C1
02980GOTO 1870
02990S3=0
03000FOR I=C1 TO M
03010S3=S3+A(I)
03020NEXT I
03030S3=S3/M
03040Q1=0
03050FOR I=C1 TO M
03060Q1=Q1+(A(I)-S3)*(A(I))
03070NEXT I
03080S3=0
03090Q0=0
03100FOR I=C1 TO M
03110FOR J=C1 TO N(I)
03120Q0=Q0+(Y(S3+J)-A(I)-Q(S3+J))**2
03130NEXT J
03140S3=S3+N(I)
03150NEXT I
03160P0=(L0+Q0)/(S0+5)
03170P1=(L1+Q1)/(M+2)
03180GOTO 2930
03185 SCRATCH #2
03190 PRINT#2,M,P,P0,P1,C0
03210 FOR I=1 TO M
03211PRINT#2,A(I)
03212NEXTI
03213 FOR I=1 TO P
03214 PRINT#2,B(I)
03215NEXTI
03216FORI=1TO5
03217 PRINT#2,J(I)
03218NEXTI
03220CHAIN "CMOD63"
09000INPUT O1
09020IF O1=-9999 THEN 9040
09030RETURN
09040CHAIN "RSTRT"
09999END