Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0113/cmod78.bas
There are 2 other files named cmod78.bas in the archive. Click here to see a list.
00040REM CMOD78 CMOD78 CMOD78 CMOD78 CMOD78
00050 DIM Y(333,5),N(12),X(333,5),J(5),R(5,5),C(5,5)
00060 DIM M(5),L(5)
00070PRINT L$
00080G7=0
00090PRINT " MULTIPLE LINEAR REGRESSION - DATA ENTRY"
00100PRINT " "
00110 FILES RFILE1,RFILE2,RFILE3,RF4,RF5,RF6,RF7,RF8,RF9
00150RESTORE#1
00151 INPUT# 1,I1,I2,I3
00160SCRATCH#1
00161 PRINT # 1,78,I2,I3
00170RESTORE#4
00171 INPUT# 4,N$
00180 IF N$ <> "$$$$$$" THEN 500
00190PRINT "THERE ARE NO DATA IN WORKING STORAGE. IF YOU WANT TO ENTER"
00200PRINT "DATA OR RETRIEVE IT FROM A FILE USE COMPONENT 1."
00210PRINT
00220PRINT "THERE IS A DATA SET AVAILABLE FOR DEMONSTRATING THE MULTIPLE"
00230PRINT "REGRESSION ANALYSIS."
00240PRINT
00250PRINT "IF YOU WANT THE DEMONSTRATION DATA TYPE '1', ELSE '0'.";
00260GOSUB 9000
00270IF O1 <> 1 THEN 360
00280 FILE #1,"C8LL6"
00290 GOTO 410
00360CHAIN "RSTRT"
00410RESTORE#1
00411 INPUT#1,N$
00412INPUT#1,N$
00413 INPUT#1,M
00414INPUT#1,P
00415INPUT#1,G$
00416INPUT#1,V$
00417 MARGIN #4,100
00420 SCRATCH #4
00421 PRINT#4,N$
00422 PRINT#4,M
00423PRINT#4,P
00424PRINT#4,CHR$(34);G$;CHR$(34)
00425PRINT#4,CHR$(34);V$;CHR$(34)
00430FORI=1TO12
00431INPUT#1,N(I)
00432 PRINT#4,N(I)
00433 NEXT I
00440MAT X=ZER(N(1),P)
00450FORI=1TON(1)
00451FORJ=1TOP
00452INPUT#1,X(I,J)
00453 PRINT#4,X(I,J)
00454NEXTJ
00455NEXT I
00500GOSUB 1210
00510IF P >= 3 THEN 580
00520PRINT "THIS MODEL IS FOR A DATA SET WITH MORE THAN 2 VARIABLES. SIMPLE"
00530PRINT "LINEAR REGRESSION IS COMPONENT 7."
00540PRINT
00550PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
00560GOSUB 9000
00570CHAIN "RSTRT"
00580PRINT
00590PRINT "DATA SET NAME =";N$
00600PRINT " "
00610GOSUB 1210
00620IF M=0 THEN 700
00630PRINT
00640PRINT"GROUPS ";1;" "MID$(G$,1,6);" OBSERVATIONS= ";N(1)
00650FOR I=2 TO M
00655O1=I*6-5
00660 PRINT " ";I;" ";MID$(G$,O1,O1+5-(O1)+1)" ";N(I)
00670NEXT I
00680PRINT " "
00690GOTO 710
00700PRINT "OBSERVATIONS=";N(1)
00710PRINT
00720 PRINT "VARIABLES ";1;" ";MID$(V$,1,6-(1)+1)
00730FOR I=2 TO P
00740 PRINT " ";I;" ";MID$(V$,I*6-5,I*6-(I*6-5)+1)
00750NEXT I
00760IF M=0 THEN 850
00770PRINT
00780PRINT "TYPE THE NUMBER OF THE GROUP YOU WANT (EXIT=0).";
00790GOSUB 9000
00800G7=INT(O1)
00810IF G7<1 THEN 830
00820IF G7 <= M THEN 850
00830PRINT "REENTER. MUST BE THE NUMBER OF A GROUP."
00840GOTO 790
00850PRINT
00860PRINT "TYPE THE NUMBER OF THE CRITERION VARIABLE (EXIT=0).";
00870GOSUB 9000
00872IF O1 <> 0 THEN 880
00873CHAIN "RSTRT"
00880C7=INT(O1)
00890IF C7<1 THEN 930
00900IF C7>P THEN 930
00910GOSUB 1250
00920GOTO 950
00930PRINT "REENTER. MUST BE VARIABLE NUMBER."
00940GOTO 870
00950MAT Y=ZER(P,S0)
00960MAT R=CON(P,P)
00970MAT Y=TRN(X)
00980MAT C=ZER(P,P)
00990MAT C=Y*X
01000MAT M=ZER(P)
01010FOR I=1 TO P
01020FOR J=1 TO S0
01030M(I)=X(J,I)+M(I)
01040NEXT J
01050NEXT I
01060FOR I=1 TO P-1
01070FOR J=I+1 TO P
01080R3=C(I,J)-M(I)*M(J)/S0
01090R(I,J)=R3/SQR((C(I,I)-M(I)*M(I)/S0)*(C(J,J)-M(J)*M(J)/S0))
01100R(J,I)=R(I,J)
01110NEXT J
01120R(I,I)=1
01130NEXT I
01140MAT L=ZER(P)
01150FOR I=1 TO P
01160L(I)=SQR((C(I,I)-M(I)*M(I)/S0)/(C(C7,C7)-M(C7)*M(C7)/S0))
01170NEXT I
01180SCRATCH#2
01181 PRINT # 2,C7,G7
01182FORI=1TOP
01183FORJ=1TOP
01184PRINT#2,R(I,J)
01185NEXTJ
01186NEXTI
01187FORI=1TOP
01188PRINT#2,L(I)
01189NEXTI
01190FORI=1TOP
01191PRINT#2,M(I)
01192NEXTI
01200CHAIN "CMOD79"
01210RESTORE#4
01211 INPUT# 4,N$,M,P,G$,V$
01220FOR I=1 TO12
01221INPUT#4,N(I)
01222NEXTI
01230S0=N(1)
01240RETURN
01250IF M=0 THEN 1350
01260IF G7=1 THEN 1350
01270FOR I=1 TO G7-1
01280J3=N(I)
01290FOR J=1 TO J3
01300 INPUT#4,D8
01310NEXT J
01320NEXT I
01330S0=N(G7)
01340GOTO 1360
01350S0=N(1)
01360MAT X=ZER(S0,P)
01370FOR I=1 TO P
01380FOR J=1 TO S0
01390 INPUT#4,X(J,I)
01400NEXT J
01410NEXT I
01420RETURN
09000REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
09005INPUT O1
09015IF O1=-9999 THEN 9025
09020RETURN
09025CHAIN "RSTRT"
09035REM*************END ROUTINE
09999END