Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50422/cmod82.bas
There are 2 other files named cmod82.bas in the archive. Click here to see a list.
00030REM*****************************************************************
00035REM     CMOD82     CMOD82     CMOD82     CMOD82     CMOD82     CMOD82
00040REM*****************************************************************
00050  DIM J(5),Q(6),X(333,5)                    ,N(12)       ,P(5)
00060  DIM L(5)
00070  DIM T(8)
00090  FILES RFILE1,RFILE2,RFILE3,RF4,,,,RF8 
00100X=0
00140RESTORE#1
00141  INPUT#  1,I1,I2,I3
00150SCRATCH#1
00151  PRINT #  1,80,I2,I3
00160GOSUB 610
00170MAT R=ZER(P,P)
00180MAT L=ZER(P)
00190MAT T=ZER(P+3)
00200MAT Q=ZER(P)
00210RESTORE#2
00211 INPUT#2,C7
00212INPUT#2,G7
00213 FOR I=1 TO P
00214 FOR J=1 TO  P
00215 INPUT#2,R(I,J)
00216NEXT J
00217NEXT I
00218 FOR I=1 TO P
00219 INPUT#2,L(I)
00220 NEXT I
00230 FOR I=1 TO P+3
00232 INPUT#8,T(I)
00233 NEXT I
00240K=1
00250MAT J=ZER(P)
00260FOR I=1 TO P
00270IF T(I)=0 THEN 310
00280J(I)=1
00290Q(I)=T(I)
00300GOTO 310
00310NEXT I
00320R0=T(P+2)
00330V6=T(P+1)
00340K=0
00350PRINT L$
00380PRINT "SAMPLE REGRESSION COEFFICIENTS"
00390PRINT "PREDICTORS            NON-STANDARDIZED    STANDARDIZED"
00400FOR I=1 TO P
00410IF J(I)=0 THEN 440
00420:  'CCCCC             #######.###         #######.###
00430  PRINT  USING 420,MID$(V$,I*6-5,I*6-(I*6-5)+1),Q(I),Q(I)*L(I)
00440NEXT I
00442:INTERCEPT            #######.###
00444PRINT  USING 442,T(P+3)
00450PRINT
00462PRINT "SAMPLE INTERCORRELATIONS"
00466GOSUB 7000
00470GOSUB 6000
00480PRINT
00520:MULTIPLE R =##.###
00530PRINT  USING 520,R0
00532PRINT
00542:MEDIAN ESTIMATE  OF ST. DEV. = #######.##
00543PRINT  USING 542,V6
00570PRINT
00580PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
00590GOSUB 9000
00595CHAIN "CMOD83"
00610RESTORE#4
00611 INPUT#4,N$
00612 INPUT#4,M
00613 INPUT#4,P
00614INPUT#4,G$
00615INPUT#4,V$
00620 FOR I=1 TO 12
00621 INPUT#4,N(I)
00622 NEXT I
00630RETURN
00640  DIM D(10),C(333)
00650MAT C=ZER(S0)
00660FOR I=1 TO 10
00670D(I)=1+INT(RND(0)*S0)
00680IF C(D(I))=0 THEN 700
00690GOTO 670
00700C(D(I))=1
00710NEXT I
00720RETURN
06000K1=0
06010FOR I=1 TO P
06020IF J(I)=0 THEN 6120
06030K1=K1+1
06040K=0
06050FOR J=1 TO I-1
06060IF J(J)=0 THEN 6100
06070IF I=J THEN 6100
06080K=K+1
06090P(K)=R(I,J)
06100NEXT J
06110GOSUB 6190
06120NEXT I
06125K=0
06130FOR I=1 TO P
06140IF J(I)=0 THEN 6170
06150K=K+1
06160P(K)=R(C7,I)
06170NEXT I
06175K1=K1+1
06180GOSUB 6190
06185RETURN
06190  ONK+1  GOTO 6210,6240,6270,6300,6330,6360
06200:  'CCCCC
06210  PRINT  USING 6200,MID$(K$,K1*6-5,K1*6-(K1*6-5)+1)
06220GOTO 6370
06230:  'CCCCC    ##.###
06240  PRINT  USING 6230,MID$(K$,K1*6-5,K1*6-(K1*6-5)+1),P(1)
06250GOTO 6370
06260:  'CCCCC    ##.###    ##.###
06270  PRINT  USING 6260,MID$(K$,K1*6-5,K1*6-(K1*6-5)+1),P(1),P(2)
06280GOTO 6370
06290:  'CCCCC    ##.###    ##.###    ##.###
06300  PRINT  USING 6290,MID$(K$,K1*6-5,K1*6-(K1*6-5)+1),P(1),P(2),P(3)
06310GOTO 6370
06320:  'CCCCC    ##.###    ##.###    ##.###    ##.###
06330  PRINT  USING 6320,MID$(K$,K1*6-5,K1*6-(K1*6-5)+1),P(1),P(2),P(3),P(4)
06340GOTO 6370
06350:  'CCCCC    ##.###    ##.###    ##.###    ##.###    ##.###
06360  PRINT  USING 6350,MID$(K$,K1*6-5,K1*6-(K1*6-5)+1),P(1),P(2),P(3),P(4),P(5)
06370RETURN
06380RETURN
07000K=0
07005 K$=""
07010FOR I=1 TO P
07020IF J(I)=0 THEN 7060
07030K=K+1
07040 K$=K$+MID$(V$,I*6-5,6)
07060NEXT I
07070K=K+1
07080 K$=K$+MID$(V$,C7*6-5,6)
07081 R1$=MID$(K$,1,6)
07082 R2$=MID$(K$,07,6) 
07083 R3$=MID$(K$,13,6) 
07084 R4$=MID$(K$,19,6) 
07085 R5$=MID$(K$,25,6)
07090  ONK  GOTO 7100,7200,7300,7400,7500
07100CHAIN "CERROR"
07190:            'CCCCC    'CCCCC
07200  PRINT  USING 7190,MID$(K$,1,6-(1)+1),MID$(K$,7,12-(7)+1)
07210GOTO 7600
07290:            'CCCCC    'CCCCC    'CCCCC
07300  PRINT  USING 7290,R1$,R2$,R3$ 
07310GOTO 7600
07390:            'CCCCC    'CCCCC    'CCCCC    'CCCCC
07400  PRINT  USING 7490,R1$,R2$,R3$,R4$ 
07410GOTO 7600
07490:            'CCCCC    'CCCCC    'CCCCC    'CCCCC    'CCCCC
07500  PRINT  USING 7490,R1$,R2$,R3$,R4$,R5$ 
07600RETURN
09000REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
09005INPUT O1
09015IF O1=-9999 THEN 9025
09020RETURN
09025CHAIN "RSTRT"
09035REM*************END ROUTINE
09999 END