Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50422/cmod80.bas
There are 2 other files named cmod80.bas in the archive. Click here to see a list.
00022V8=0
00030REM*****************************************************************
00040 DIM C(5),F(5),V(1,5),G(5,5),H(5,5),U(1,1)
00050REM CMOD80 CMOD80 CMOD80 CMOD80 CMOD80
00060REM*****************************************************************
00070 DIM J(5),Q(5,1),X(5,5) ,N(12)
00080 DIM T(8),S(5,5),A(5,5)
00082 DIM D(1,5)
00085 DIM M(1,1)
00100 DIM K(5)
00130FILES RFILE1,RFILE2,RFILE3,RF4, , ,RF7,RF8,RF9
00140X=0
00180RESTORE#1
00181 INPUT# 1,I1,I2,I3
00190GOSUB 460
00192P4=P
00200RESTORE#2
00201 INPUT# 2,C7,G7
00202S0=N(1)
00203IF G7=0 THEN 210
00204S0=N(G7)
00210K=0
00215 K$=""
00220MAT T=ZER(P+3)
00240RESTORE#8
00241FORI=1TOP+3
00242INPUT#8,T(I)
00243NEXTI
00260MAT J=ZER(P)
00270FOR I=1 TO P
00280IF T(I)=0 THEN 340
00290K=K+1
00300 K$=K$+MID$(V$,I*6-5,6)
00320K(K)=I
00330J(I)=1
00340NEXT I
00360I5=K
00370MAT S=ZER(P,P)
00380MAT A=ZER(I5+1,I5+1)
00390MAT Q=ZER(I5+1,1)
00392K=1
00393FOR I=1 TO P
00394IF J(I)=0 THEN 398
00395K=K+1
00396Q(K,1)=T(I)
00398NEXT I
00400Q(1,1)=T(P+3)
00410MAT X=ZER(I5+1,I5+1)
00430RESTORE#7
00431FORI=1TOP
00432FORJ=1TOP
00433INPUT#7,S(I,J)
00434NEXTJ
00435NEXTI
00440GOSUB 670
00442S8=T(P+1)*T(P+1)*(S0-I5-1)
00443G=S0-I5-1
00450GOTO 1000
00460RESTORE#4
00461 INPUT# 4,N$,M,P,G$,V$
00470FORI=1TO12
00471INPUT#4,N(I)
00472NEXTI
00477RETURN
00480IF M=0 THEN 590
00490IF G7=1 THEN 590
00500S0=0
00510FOR I=1 TO G7-1
00520S0=S0+N(I)
00530NEXT I
00540FOR I=1 TO S0*P
00550 INPUT#4,C3
00560NEXT I
00570S0=N(G7)
00580GOTO 600
00590S0=N(1)
00600MAT X=ZER(S0,P)
00610FOR I=1 TO P
00620FOR J=1 TO S0
00630 INPUT#4,X(J,I)
00640NEXT J
00650NEXT I
00660RETURN
00670K0=0
00680K4=0
00690A(1,1)=S(1,1)
00700FOR I=1 TO P
00710K1=0
00720K3=0
00730IF I <> C7 THEN 750
00740K4=1
00750IF J(I)=1 THEN 780
00760K0=K0+1
00770GOTO 890
00780FOR J=1 TO P
00790IF C7 <> J THEN 810
00800K3=K3+1
00810IF J(J)=1 THEN 840
00820K1=K1+1
00830GOTO 880
00840REM
00850A(I+1-K0,J+1-K1)=S(I+1-K4,J+1-K3)
00860A(1,J+1-K1)=S(1,J+1-K3)
00870A(I+1-K0,1)=S(I+1-K4,1)
00880NEXT J
00890NEXT I
00900RETURN
01000REM I5 IS NUMBER OF PREDICTORS CHOSEN
01010REM P4 IS TOTAL NUMBER OF PREDICTORS
01020REM C7 IS NUMBER OF CRITERION VARIABLE
01030REM S8 IS RESIDUAL SUM OF PRODUCTS (Y-YHAT)
01040REM G IS DEGREES OF FREEDOM FOR ALL PREDICTIVE DISTRIBUTIONS
01050MAT X=ZER(I5+1,I5+1)
01080MAT W=ZER(I5+1,1)
01090MAT V=CON(1,I5+1)
01100MAT D=ZER(1,I5+1)
01102MAT H=ZER(1,1)
01110 REM V$ CONTAINS NAMES OF VARIABLES
01120REM X CONTAINS VARIANCE/COVARIANCE MATRIX
01130REM Q CONTAINS BETA WEIGHTS
01140REM J INDICATOR VECTOR 1-SIGNIFIES PREDICTOR
01142MAT X=INV(A)
01150PRINT L$
01160PRINT " PREDICTIVE DISTRIBUTIONS"
01170PRINT
01180IF V8=1 THEN 1200
01183PRINT "FOR ANY SET OF PREDICTOR SCORES YOU CAN EXAMINE THE PREDICTIVE"
01190PRINT "DISTRIBUTION ON THE"
01200PRINT " 1. NEXT OBSERVATION."
01210PRINT " 2. MEAN OF A SAMPLE OF SIZE N."
01220PRINT
01230PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT(NONE=0).";
01240GOSUB 9000
01250IF O1 <> 0 THEN 1270
01260CHAIN "CMOD83"
01270IF O1=1 THEN 1310
01280IF O1=2 THEN 1310
01290PRINT "REENTER. INPUT MUST BE NUMBER OF OPTION."
01300GOTO 1240
01310O9=O1
01320 ONO9 GOTO 1330,1350
01330 H$="PREDICTIVE DISTRIBUTION ON THE NEXT OBSERVATION"
01340GOTO 1360
01350 H$="PREDICTIVE DISTRIBUTION ON MEAN OF SAMPLE OF SIZE ="
01360IF V8=0 THEN 1370
01361PRINT
01362PRINT "IF YOU WANT TO CHANGE PREDICTOR VALUES TYPE '1', ELSE '0'.";
01363GOSUB 9000
01364IF O1=1 THEN 1370
01365GOTO 1470
01370PRINT L$
01372K0=2
01380PRINT "ENTER THE PREDICTOR VALUES OF INTEREST."
01390FOR I=1 TO P4
01400IF J(I)=0 THEN 1460
01410 PRINT MID$(V$,I*6-5,I*6-(I*6-5)+1)," =";
01420GOSUB 9000
01430V(1,K0)=O1
01440K(K0-1)=I
01450K0=K0+1
01460NEXT I
01462V8=1
01470MAT W=TRN(V)
01480MAT M=V*Q
01490MAT D=V*X
01500MAT H=D*W
01510M0=M(1,1)
01520IF O9=1 THEN 1630
01530PRINT
01540PRINT "INPUT THE SAMPLE SIZE.";
01550GOSUB 9000
01560O1=INT(O1)
01570IF O1>1 THEN 1600
01580PRINT "REENTER. SAMPLE SIZE MUST BE AT LEAST 2."
01590GOTO 1550
01600N0=O1
01610S0=SQR(S8*(1/N0+H(1,1))/(G-2))
01620GOTO 1640
01630S0=SQR(S8*(1+H(1,1))/(G-2))
01640REM
01650PRINT L$
01660PRINT " 1. HIGHEST DENSITY REGION"
01670PRINT " 2. PROBABILITY LESS THAN SOME VALUE."
01680PRINT " 3. PROBABILITY BETWEEN TWO VALUES."
01690PRINT
01700PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT (NONE=0).";
01710GOSUB 9000
01720IF O1 <> 0 THEN 1750
01730PRINT L$
01740GOTO 1180
01750IF O1=1 THEN 1800
01760IF O1=2 THEN 2190
01770IF O1=3 THEN 2400
01780PRINT "YOU DID NOT SPECIFY 1,2 OR 3. PLEASE RESPECIFY."
01790GOTO 1710
01800PRINT L$
01810PRINT " HIGHEST DENSITY REGIONS"
01820PRINT " "
01830GOTO 2020
01840PRINT
01850IF O9=1 THEN 1880
01860 PRINT H$;N0
01870GOTO 1882
01880PRINT H$
01882PRINT "PREDICTOR VALUE COEFFICIENT"
01890FOR I=1 TO I5
01900:'CCCCC =#######.## #######.###
01910 PRINT USING 1900,MID$(V$,K(I)*6-5,K(I)*6-(K(I)*6-5)+1),V(1,I+1),Q(I+1,1)
01920NEXT I
01940:---------------------- 'CCCCC ------------------------------
01950 PRINT USING 1940,MID$(V$,C7*6-5,C7*6-(C7*6-5)+1)
01960:MEAN ######.## DEGREES OF FREEDOM ######
01970PRINT USING 1960,M0,G
01980:STANDARD DEV. ####.## SCALE PARAMETER ########.##
01990PRINT USING 1980,S0,S0*S0*(G-2)
02000PRINT "--------------------------------------------------------------"
02010RETURN
02020PRINT "TO EXIT ROUTINE TYPE '0' WHEN ASKED FOR INPUT."
02030PRINT "INPUT P% AS NUMBER FROM 1 THROUGH 99."
02040GOSUB 1840
02050PRINT "P%=";
02060GOSUB 9000
02070IF O1=0 THEN 1640
02080IF O1>99 THEN 2110
02090IF O1<1 THEN 2110
02100GOTO 2130
02110PRINT "P% MUST BE AT LEAST 1% AND NOT GREATER THAN 99%. REENTER."
02120GOTO 2060
02130P0=O1/200+.5
02140GOSUB 2760
02150: ##.#% HDR = #####.## TO ######.##
02160F0=J2*SQR(S0*S0*(G-2)/G)
02170PRINT USING 2150,O1,M0-F0,M0+F0
02180GOTO 2050
02190PRINT L$
02200PRINT " PROBABILITY LESS THAN SOME VALUE"
02210PRINT " "
02220PRINT "TO EXIT ROUTINE TYPE '7777' WHEN ASKED FOR INPUT."
02230GOSUB 1840
02240PRINT "INPUT VALUE";
02250GOSUB 9000
02260IF O1=7777 THEN 1640
02270X3=O1
02280Y0=ABS(M0-X3)
02290J2=Y0/S0/SQR((G-2)/G)
02300J1=0
02310GOSUB 6000
02320P=P-.5
02330IF X3<M0 THEN 2360
02340P=.5+P
02350GOTO 2370
02360P=.5-P
02370: PROB LESS THAN ######.## =##.##
02380PRINT USING 2370,O1,P
02390GOTO 2240
02400PRINT L$
02410PRINT " PROBABILITY BETWEEN TWO VALUES"
02420PRINT
02430PRINT "TO EXIT ROUTINE TYPE '0,0' WHEN ASKED FOR INPUT."
02440GOSUB 1840
02450PRINT "INPUT (SMALLER,LARGER)";
02460GOSUB 9050
02470IF O1 <> 0 THEN 2500
02480IF O2 <> 0 THEN 2500
02490GOTO 1640
02500IF O1 <= O2 THEN 2530
02510PRINT "SMALLER VALUE MUST BE ENTERED FIRST. RESPECIFY."
02520GOTO 2460
02530X3=O1
02540X4=O2
02550Y0=ABS(M0-X3)
02560J2=Y0/S0/SQR((G-2)/G)
02570J1=0
02580GOSUB 6000
02590P=P-.5
02600IF X3<M0 THEN 2630
02610P3=.5+P
02620GOTO 2640
02630P3=.5-P
02640Y0=ABS(M0-X4)
02650J2=Y0/S0/SQR((G-2)/G)
02660J1=0
02670GOSUB 6000
02680P5=P-.5
02690IF X4<M0 THEN 2720
02700P5=.5+P5
02710GOTO 2740
02720P5=.5-P5
02730: PROB(######.## < T < ######.##)=##.##
02740PRINT USING 2730,X3,X4,P5-P3
02750GOTO 2450
02760REM %ILE FINDER
02770P5=2
02780P6=2
02790P2=P0
02800GOSUB 3060
02810IF ABS(P-P0)<.0001 THEN 3050
02820IF P>P0 THEN 2890
02830E5=J2
02840P5=P
02850IF P6 <> 2 THEN 2950
02860P2=P2+.001
02870GOSUB 3060
02880GOTO 2810
02890E6=J2
02900P6=P
02910IF P5 <> 2 THEN 2950
02920P2=P2-.001
02930GOSUB 3060
02940GOTO 2810
02950J2=.5*(E6+E5)
02960GOSUB 6000
02970IF ABS(P-P0)<.0001 THEN 3050
02980IF P>P0 THEN 3020
02990P5=P
03000E5=J2
03010GOTO 2950
03020E6=J2
03030P6=P
03040GOTO 2950
03050RETURN
03060P3=P2
03070IF P2 <= .5 THEN 3090
03080P2=1-P2
03090A1=SQR(LOG(1/P2/P2))
03100A2=2.51552+.802853*A1+.010328*A1*A1
03110A2=A2/(1+1.43279*A1+.189269*A1*A1+.001308*A1*A1*A1)
03120A2=A1-A2
03130J2=SQR(G*EXP(A2*(G-5/6)*A2/(G-2/3+.1/G)/(G-2/3+.1/G))-G)
03140GOSUB 6000
03150IF P3 <= .5 THEN 3180
03160P2=P3
03170GOTO 3200
03180J2=-J2
03190P=1-P
03200RETURN
06000REM T CDF
06003L0=LOG(1+J2*J2/G)
06004IF L0>.000001 THEN 6006
06005L0=0
06006P=.5
06007IF J2=0 THEN 6035
06008IF J2<6 THEN 6013
06009P=1
06010GOTO 6035
06011IF J2>12 THEN 6009
06013Y3=J2
06015Y3=(G-2/3+.1/G)*SQR(L0/(G-5/6))
06016GOSUB 8000
06017GOTO 6035
06035RETURN
08000REM NORMAL CDF
08050Y4=ABS(Y3)
08060X1=X
08070X=Y3
08080T=1/(1+.231642*Y4)
08090D=.398942*EXP(-X*X/2)
08100C1=1.33027
08110C2=1.82126
08120C3=1.78148
08130C4=.356564
08140C5=.319382
08150P=1-D*T*((((C1*T-C2)*T+C3)*T-C4)*T+C5)
08160IF X >= 0 THEN 8180
08170P=1-P
08180X=X1
08190RETURN
09000REM
09005INPUT O1
09010IF O1=-9999 THEN 9020
09015RETURN
09020CHAIN "RSTRT"
09050INPUT O1,O2
09055IF O2=-9999 THEN 9020
09060GOTO 9010
09999END