Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - decus/20-0025/sixcur.bas
There are 2 other files named sixcur.bas in the archive. Click here to see a list.
00010	DIMA(6),B(6),C(7),X(180),Y(180),U(180),V(180),Z(6)
00012	LET I=0
00015	LETC(0)=-2
00020	LET T1=0
00025	LET T2=0
00030	LET T3=0
00035	LET M=0
00040	LET A2=0
00045	LET A3=0
00050	LETB2=0
00055	LETB3=0
00065	LET I=0
00070	FORK=1TO6
00075	LETZ(K)=0
00080	NEXTK
00085	LETI=I+1
00090	READX(I),Y(I)
00100	GO TO 1990
00150	DATA 1E37,1E37
00151	IFX(I)<>1E37THEN 85
00152	IFY(I)<>1E37THEN 85
00153	LETN=I-1
00154	FORI=1TON
00155	LETT1=T1+X(I)
00156	LETT2=T2+Y(I)
00157	LETT3=T3+Y(I)^2
00160	IFX(I)<>0THEN 175
00165	LETA2=A2+1
00170	GOTO 180
00175	LETA2=A2
00180	IFX(I)>=0THEN 195
00185	LETA3=A3+1
00190	GOTO 200
00195	LETA3=A3
00200	IFY(I)<>0THEN 220
00205	LETB2=B2+1
00210	GOTO 225
00220	LETB2=B2
00225	IFY(I)>=0THEN 240
00230	LETB3=B3+1
00235	GOTO 241
00240	LETB3=B3
00241	NEXTI
00245	FORI=1TON-1
00250	FORJ=I+1TON
00255	IFX(I)<=X(J)THEN 295
00260	LETP=X(I)
00265	LET Q=Y(I)
00270	LETX(I)=X(J)
00275	LETY(I)=Y(J)
00280	LETX(J)=P
00285	LETY(J)=Q
00290	NEXTJ
00295	NEXTI
00300	IFA2<=0THEN 320
00305	LETZ(3)=-1
00310	LETZ(4)=-1
00315	LETZ(6)=-1
00320	IFA3<=0THEN 330
00325	LETZ(3)=-1
00330	IFB2<=0THEN 355
00335	LETZ(2)=-1
00340	LETZ(3)=-1
00345	LETZ(5)=-1
00350	LETZ(6)=-1
00355	IFB3<=0THEN 370
00360	LETZ(2)=-1
00365	LETZ(3)=-1
00370	PRINT
00375	PRINT"LEAST SQUARES FIT OF SIX CURVE TYPES:"
00380	PRINT
00385	PRINT"NUMBER"," CURVE"," INDEX","    A","    B"
00390	PRINT
00395	LETR2=C(0)
00400	LETX2=T1/N
00405	LETY4=T2/N
00410	FORK=1TO6
00415	PRINTK,
00420	GOSUB 1000
00425	IFK<>1THEN 435
00430	PRINT"Y=A+B*X",
00431	GOTO 485
00435	IFK<>2THEN 445
00440	PRINT"Y=A*EXP(B*X)",
00441	GOTO 485
00445	IFK<>3THEN 455
00450	PRINT"Y=A*(X^B)",
00451	GOTO 485
00455	IFK<>4THEN 465
00460 PRINT"Y=A+(B/X)",
00461	GOTO 485
00465	IFK<>5THEN 475
00470	PRINT"Y=1/(A+B*X)",
00471	GOTO 485
00475	IFK<>6THEN 485
00480	PRINT"Y=X/(A*X+B)",
00485	IFZ(K)<0THEN 520
00490	IFL3<>0THEN 505
00495	LETA(K)=EXP(A(K))
00500	GOTO 510
00505	LETA(K)=A(K)
00510	PRINT,C(K),A(K),B(K)
00511	NEXTK
00515	GOTO 525
00520	PRINT"CAN'T FIT....SOME DATA IS ZERO OR NEGATIVE"
00525	PRINT
00530	PRINT"FOR WHICH CURVE ARE DETAILS DESIRED (NUMBER) ";
00535	INPUT M
00536	IF M= 0 GO TO 1999
00540	IFM>0 THEN 545
00541	GO TO 550
00545	IFM<7THEN 565
00550	PRINT
00555	PRINT"....ANSWER 1,2,3,4,5, OR 6...."
00560	GOTO 530
00565	IFZ(M)>=0THEN 590
00570	PRINT
00575	PRINT"....THAT CURVE HAS NOT BEEN FITTED....TRY ANOTHER?"
00580	PRINT
00585	GOTO 530
00590	LETK=M
00595	GOSUB 1000
00600	LETM=K
00605	LETS8=SQR((D2-B1*D3)/(N*(N-2)))
00610	LETS9=S8/SQR(D1/N)
00615	LETS6=S8/SQR(N)
00620	LETT4=1.95996+2.37226/(N-2)+2.8225/((N-2)^2)
00625	LETP=T4*S6
00630	LETQ=T4*S9
00635	LETA2=A1-P
00640	LETA3=A1+P
00645	LETB2=B1-Q
00650	LETB3=B1+Q
00655	IFL3<>0THEN 675
00660	LETA1=EXP(A1)
00665	LETA2=EXP(A2)
00670	LETA3=EXP(A3)
00675	PRINT
00680	PRINT"RESULTS FOR THE SELECTED CURVE ARE:"
00685	PRINT
00690	PRINT"COEFFICIENTS:"
00695	PRINT
00700	PRINT"           EXPECTED VALUE    95 PCT CONFIDENCE LIMITS"
00705	PRINT
00710	PRINT"      A:",A1,A2,A3
00715	PRINT"      B:",B1,B2,B3
00720	PRINT
00725	PRINT"MEAN VALUES:"
00730	PRINT
00735	PRINT"      XBAR =",X2,"      YBAR =",Y4
00740	PRINT
00745	PRINT"ESTIMATED VALUE AND CONFIDENCE LIMITS FOR:"
00750	PRINT"THE INDIVIDUAL VALUE OF Y FOR EACH X:"
00755	PRINT
00760	PRINT"X-ACTUAL","Y-ACTUAL","Y-ESTIM","95 PCT CONFIDENCE LIMITS"
00765	PRINT
00770	FORI=1TON
00775	LETT=U(I)
00780	GOSUB 1500
00785	LETU(I)=T
00790	PRINTX(I),Y(I),P,Y2,Y3
00795	NEXTI
00799	PRINT
00800	GO TO 530
00815	DATA 9E37
00820	PRINT"CALCULATED VALUES OF Y FOR EXTRA X'S SUPPLIED:"
00825	PRINT
00830	PRINT"X-EXTRA"," ","Y-ESTIM","95 PCT CONFIDENCE LIMITS"
00835	PRINT
00840	READT1
00845	IFT1<>9E37THEN 870
00850	RESTORE
00854	FOR I=1 TO N+1
00855	READX(I),Y(I)
00856	NEXT I
00860	PRINT
00865	GOTO 530
00870	IFM<>3THEN 885
00875	LETR2=LOG(T1)
00880	GOTO 905
00885	IFL1=0THEN 900
00890	LETR2=T1
00895	GOTO 905
00900	LETR2=1/T1
00905	LETT=R2
00910	GOSUB 1500
00920	PRINTT1," ",P,Y2,Y3
00930	GOTO 840
01000	IFZ(K)>=0THEN 1030
01010	LETC(K)=0
01020	GOTO 1480
01030	LETL1=(K-4)*(K-6)
01040	LETL2=(K-5)*(K-6)
01050	LETL3=(K-2)*(K-3)
01060	LETS1=0
01070	LETS2=0
01080	LETS3=0
01090	LETS4=0
01100	LETS5=0
01110	FORI=1TON
01120	IFL3<>0THEN 1150
01130	LETV(I)=LOG(Y(I))
01140	GOTO 1190
01150	IFL2<>0THEN 1180
01160	LETV(I)=1/Y(I)
01170	GOTO 1190
01180	LETV(I)=Y(I)
01190	IFK<>3THEN 1220
01200	LETU(I)=LOG(X(I))
01210	GOTO 1260
01220	IFL1<>0THEN 1250
01230	LETU(I)=1/X(I)
01240	GOTO 1260
01250	LETU(I)=X(I)
01260	LETS1=S1+U(I)
01270	LETS2=S2+V(I)
01280	LETS3=S3+U(I)^2
01290	LETS4=S4+V(I)^2
01300	LETS5=S5+U(I)*V(I)
01310	NEXTI
01320	LETX1=S1/N
01330	LETY1=S2/N
01340	LETD1=N*S3-S1^2
01350	LETD2=N*S4-S2^2
01360	LETD3=N*S5-S1*S2
01370	LETB1=B(K)
01375	LETB1=D3/D1
01380	LETB(K)=D3/D1
01390	LETA1=A(K)
01395	LET A1=Y1-B1*X1
01400	LETA(K)=Y1-B1*X1
01430	LETS1=0
01440	LETS3=0
01450	FORI=1TON
01452	LETW=Y1+B1*(U(I)-X1)
01454	IFL3<>0THEN 1460
01456	LETW=EXP(W)
01458	GOTO 1466
01460	IFL2<>0THEN 1464
01462	LETW=1/W
01463	GOTO 1466
01464	LETW=W
01466	LETW=Y(I)-W
01468	LETS1=S1+W
01470	LETS3=S3+W^2
01472	NEXTI
01474	LETC(K)=1-(N*S3-S1^2)/(N*T3-T2^2)
01476	IFC(K)>=0THEN 1480
01478	LETC(K)=0
01480	RETURN
01500	LETS7=S8*SQR(1+1/N+((T-X1)^2)/(D1/N))
01510	LETP=Y1+B1*(T-X1)
01520	LETS1=T4*S7
01530	LETY2=P-S1
01540	LETY3=P+S1
01550	IFL3<>0THEN 1590
01560	LETP=EXP(P)
01570	LETY2=EXP(Y2)
01580	LETY3=EXP(Y3)
01590	IFL2<>0THEN 1630
01600	LETP=1/P
01610	LETY2=1/Y2
01620	LETY3=1/Y3
01630	RETURN
01990	PRINT"LIST THE FILE 'SIXEXP*' FOR INSTRUCTIONS ON USING SIXCUR*"
01999	END