Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50422/cmod79.bas
There are 2 other files named cmod79.bas in the archive. Click here to see a list.
00020REM CMOD79 CMOD79 CMOD79 CMOD79 CMOD79
00030 DIM Y(333,1),N(12),X(333,4),J(5),A(5,5),M(5,5)
00040 DIM S(5,5),T(15,8)
00050 DIM C(333,1),D(333,1),E(1,333),F(1,1),Q(5,1),P(5,1),Z(5,5)
00060 DIM I(5),G(15)
00070DATA 1,2,4,8,3,5,6,9,10,12,7,11,13,14,15
00080MAT READ G
00090D0=0
00092Z0=0
00098 B$=" "
00100 H$=" PREDICTOR "
00105 Y$=" COMBINATIONS"
00110 F$=" ST DEV R DF"
00112 X$="RESIDUAL MULT "
00120V9=0
00130O9=1
00140PRINT L$
00150PRINT " MULTIPLE LINEAR REGRESSION ON ALL POSSIBLE COMBINATIONS"
00160PRINT " "
00170PRINT "FOR ALL POSSIBLE COMBINATIONS OF THE PREDICTOR (NON-CRITERION)"
00180PRINT "VARIABLES THIS MODULE COMPUTES:"
00190PRINT " 1. THE DEGREES OF FREEDOM AND MEDIAN OF THE DISTRIBUTION"
00200PRINT " ON THE RESIDUAL STANDARD DEVIATION."
00210PRINT " 2. THE COEFFICIENT OF MULTIPLE DETERMINATION, THE RATIO OF"
00220PRINT " THE SUM OF SQUARES ON REGRESSION TO THE TOTAL SUM OF"
00222PRINT " SQUARES."
00230PRINT
00240PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
00250GOSUB 9000
00260 FILES RFILE1,RFILE2,RFILE3,RF4,RF5,RF6,RF7,RF8,RF9
00300RESTORE#1
00301 INPUT# 1,I1,I2,I3
00310SCRATCH#1
00311 PRINT # 1,79,I2,I3
00320RESTORE#2
00321 INPUT# 2,C7,G7
00322RESTORE#4
00323INPUT#4,N$
00324INPUT#4,M
00325INPUT#4,P
00326INPUT#4,G$
00327INPUT#4,V$
00331MAT T=ZER(2**(P-1)-1,P+3)
00332FORI=1TO12
00333INPUT#4,N(I)
00334NEXTI
00340IF M=0 THEN 350
00341IF G7=1 THEN 350
00342FOR I=1 TO G7-1
00343Z0=Z0+N(I)
00344NEXT I
00345FOR I=1 TO Z0*P
00346 INPUT#4,R2
00347NEXT I
00348S0=N(G7)
00349GOTO 380
00350S0=N(1)
00380MAT Y=ZER(S0,1)
00390I5=0
00400S3=0
00410PRINT L$
00420PRINT "HERE ARE THE MEDIAN OF THE DISTRIBUTION ON THE RESIDUAL"
00430PRINT "STANDARD DEVIATION, THE SAMPLE COEFFICIENT OF MULTIPLE"
00440PRINT "DETERMINATION AND THE DEGREES OF FREEDOM."
00450PRINT
00455 PRINT H$;MID$(B$,1,8+8*(P-3)-(1)+1);X$
00460 PRINT Y$;MID$(B$,1,8+8*(P-3)-(1)+1);F$
00480S3=0
00490MAT S=ZER(P,P)
00500I4=0
00510V8=0
00520I9=2 ** (P-1)-1
00530GOTO 580
00540FOR I7=1 TO 15
00550IF G(I7)>2 ** (P-1)-1 THEN 2120
00560I4=I4+1
00570I9=G(I7)
00580MAT J=ZER(P)
00590I5=0
00600GOSUB 2380
00610FOR J=1 TO P-1
00620I5=I5+K(J)
00630NEXT J
00640K0=0
00650K3=0
00655 K$=""
00660FOR J=1 TO P
00670IF J=C7 THEN 740
00680J(J)=K(J-K0)
00690IF J(J)=0 THEN 720
00700 K$=K$+MID$(V$,J*6-5,6)
00710GOTO 760
00720K3=K3+1
00730GOTO 760
00740K0=1
00750K3=K3+1
00760NEXT J
00770MAT X=CON(S0,I5+1)
00780I6=1
00790FOR I1=1 TO P
00800IF J(I1)=1 THEN 910
00810IF V8=1 THEN 830
00820IF I1=C7 THEN 870
00830FOR I8=1 TO S0
00840 INPUT#4,Z9
00850NEXT I8
00860GOTO 950
00870FOR I8=1 TO S0
00880 INPUT#4,Y(I8,1)
00890NEXT I8
00900GOTO 950
00910FOR I8=1 TO S0
00920 INPUT#4,X(I8,I6+1)
00930NEXT I8
00940I6=I6+1
00950NEXT I1
00960R0=S0
00970C0=I5+1
00980MAT A=ZER(C0,C0)
00990IF V8=0 THEN 1240
01000K0=0
01010K4=0
01020A(1,1)=S(1,1)
01030FOR I=1 TO P
01040K1=0
01050K3=0
01060IF I <> C7 THEN 1080
01070K4=1
01080IF J(I)=1 THEN 1110
01090K0=K0+1
01100GOTO 1220
01110FOR J=1 TO P
01120IF C7 <> J THEN 1140
01130K3=K3+1
01140IF J(J)=1 THEN 1170
01150K1=K1+1
01160GOTO 1210
01170REM
01180A(I+1-K0,J+1-K1)=S(I+1-K4,J+1-K3)
01190A(1,J+1-K1)=S(1,J+1-K3)
01200A(I+1-K0,1)=S(I+1-K4,1)
01210NEXT J
01220NEXT I
01230GOTO 1360
01240FOR I=1 TO C0
01250FOR J=1 TO C0
01260FOR K=1 TO R0
01270A(I,J)=A(I,J)+X(K,J)*X(K,I)
01280NEXT K
01290NEXT J
01300NEXT I
01310MAT S=A
01320V8=1
01330GOSUB 1970
01340 K$=B$
01350GOTO 540
01360GOSUB 2510
01370IF L0=1 THEN 1500
01380T(I4,P+2)=9999
01390 ONP-1 GOTO 1400,1420,1450,1480
01400CHAIN "CERROR"
01410:##. 'CCCCC 'CCCCC 'CCCCC 'CCCCC NON-INVERTIBLE MATRIX
01420Z$=MID$(K$,1,6)
01421Z1$=MID$(K$,7,6)
01422Z2$=MID$(K$,13,6)
01423Z3$=MID$(K$,19,24)
01424PRINTUSING1410,I9,Z$,Z1$,Z2$,Z3$
01430GOTO 1850
01440:##. 'CCCCC 'CCCCC 'CCCCC NON-INVERTIBLE MATRIX
01450Z$=MID$(K$,1,6)
01451Z1$=MID$(K$,7,6)
01452Z2$=MID$(K$,13,6)
01453PRINTUSING1440,I9,Z$,Z1$,Z2$
01460GOTO 1850
01470:##. 'CCCCC 'CCCCC NON-INVERTIBLE MATRIX
01480 PRINT USING 1470,I9,MID$(K$,1,6-(1)+1),MID$(K$,7,12-(7)+1)
01490GOTO 1850
01500REM ROUTINE TO GET INVERSE (X'X)
01510MAT A=M
01520REM ROUTINE TO GET INV(X'X)X'Y
01530MAT P=ZER(C0,1)
01540FOR I=1 TO C0
01550FOR J=1 TO R0
01560P(I,1)=P(I,1)+X(J,I)*Y(J,1)
01570NEXT J
01580NEXT I
01590MAT Q=ZER(C0,1)
01600MAT Q=A*P
01610MAT C=ZER(R0,1)
01620MAT D=ZER(R0,1)
01630MAT E=ZER(1,R0)
01640MAT C=X*Q
01650MAT D=Y-C
01660MAT E=TRN(D)
01670MAT F=E*D
01680S8=F(1,1)
01690V6=S0-C0
01710M5=SQR(S8/(V6-.66667))
01730GOSUB 2020
01740IF V9=1 THEN 2310
01750 ONP-1 GOTO 1760,1840,1810,1780
01760CHAIN "CERROR"
01770:##. 'CCCCC 'CCCCC 'CCCCC 'CCCCC ######.## ##.### ####
01780Z$=MID$(K$,1,6)
01781Z1$=MID$(K$,7,6)
01782Z2$=MID$(K$,13,6)
01783Z3$=MID$(K$,19,6)
01784PRINTUSING1770,I4,Z$,Z1$,Z2$,Z3$,M5,R2,V6
01790GOTO 1850
01800:##. 'CCCCC 'CCCCC 'CCCCC ######.## ##.### ####
01810Z$=MID$(K$,1,6)
01811Z1$=MID$(K$,7,6)
01812Z2$=MID$(K$,13,6)
01813PRINTUSING1800,I4,Z$,Z1$,Z2$,M5,R2,V6
01820GOTO 1850
01830:##. 'CCCCC 'CCCCC ######.## ##.### ####
01840 PRINT USING 1830,I4,MID$(K$,1,6-(1)+1),MID$(K$,7,12-(7)+1),M5,R2,V6
01850IF T(I4,P+2)=9999 THEN 1950
01860K=1
01870FOR I=1 TO P
01880IF J(I)=0 THEN 1910
01890K=K+1
01900T(I4,I)=Q(K,1)
01910NEXT I
01920T(I4,P+3)=Q(1,1)
01930T(I4,P+1)=M5
01940T(I4,P+2)=R2
01950GOSUB 1970
01960GOTO 2000
01970RESTORE#4
01971 INPUT#4,N$
01972 INPUT#4,M
01973 INPUT#4,P
01974 INPUT#4,G$
01975 INPUT#4,V$
01976 FOR I=1 TO 12
01977 INPUT#4,N(I)
01978 NEXT I
01981IF M=0 THEN 1990
01982IF G7=1 THEN 1990
01983FOR I=1 TO Z0*P
01984 INPUT#4,R2
01985NEXT I
01986S0=N(G7)
01988GOTO 1992
01990S0=N(1)
01992RETURN
02000 K$=B$
02010GOTO 2120
02020MAT E=TRN(Y)
02030MAT F=E*Y
02040Y0=0
02050FOR I=1 TO S0
02060Y0=Y(I,1)+Y0
02070NEXT I
02080R2=1-S8/(F(1,1)-Y0*Y0/S0)
02090IF R2<.999 THEN 2110
02100R2=.999
02110RETURN
02120NEXT I7
02130PRINT
02140PRINT "IF YOU WANT TO FURTHER EXAMINE THE REGRESSION ON ANY "
02142PRINT "PREDICTOR COMBINATION TYPE THE APPROPRIATE NUMBER (NONE=0).";
02150GOSUB 9000
02160IF O1 <> 0 THEN 2180
02170CHAIN "CMOD78"
02180O1=INT(O1)
02190IF O1<1 THEN 2210
02200IF O1 <= 2 ** (P-1)-1 THEN 2230
02210PRINT "REENTER. INPUT MUST BE NUMBER OF PREDICTOR SET."
02220GOTO 2150
02230IF T(O1,P+2)=9999 THEN 2290
02240FOR I=1 TO P
02250J(I)=T(O1,I)
02260NEXT I
02270J(C7)=0
02280GOTO 2310
02290PRINT "REENTER. YOU SELECTED A SET WITH AN NON-INVERTIBLE MATRIX."
02300GOTO 2150
02310SCRATCH#7
02320FORI=1TOP
02321FORJ=1TOP
02322PRINT#7,S(I,J)
02323NEXTJ
02324NEXTI
02325FORI=1TO2**(P-1)-1
02326FORJ=1TOP+3
02327PRINT#7,T(I,J)
02328NEXTJ
02329NEXTI
02330SCRATCH#8
02331 PRINT # 8 ,
02340FOR I=1 TO P+3
02342IF I <> C7 THEN 2350
02344PRINT#8,0
02345GOTO 2360
02350 PRINT#8,T(O1,I)
02360NEXT I
02370CHAIN "CMOD83"
02380REM
02390K0=1
02400I1=I9
02410MAT K=ZER(P-1)
02420I0=I1/2
02430I2=INT(I1/2)
02440IF I0=I2 THEN 2460
02450K(K0)=1
02460IF I2=0 THEN 2500
02470K0=K0+1
02480I1=I2
02490GOTO 2420
02500RETURN
02510MAT M=ZER(C0,C0)
02520MAT Z=ZER(C0,C0)
02530MAT M=A
02540MAT Z=A
02550L0=1
02560FOR I=1 TO C0
02570IF ABS(M(I,I))<1.E-07 THEN 2730
02580FOR J=1 TO C0
02590FOR K=1 TO C0
02600Z(J,K)=Z(J,K)-M(J,I)*M(K,I)/M(I,I)
02610NEXT K
02620NEXT J
02630FOR J=1 TO C0
02640Z(I,J)=M(I,J)/M(I,I)
02650Z(J,I)=M(J,I)/M(I,I)
02660NEXT J
02670Z(I,I)=-1/M(I,I)
02680MAT M=Z
02690NEXT I
02700MAT M=(-1)*M
02710MAT Z=M*A
02720L0=1
02730RETURN
02740RETURN
09000REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
09005INPUT O1
09015IF O1=-9999 THEN 9025
09020RETURN
09025CHAIN "RSTRT"
09035REM*************END ROUTINE
09999END