Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0025/provar.bas
There are 2 other files named provar.bas in the archive. Click here to see a list.
10 REM  LINES 12-18 OF PROVAR*** ARE DATA FOR NORMAL
11 REM  CURVE INTERPOLATION SUBROUTINE.
12 DATA 5000000,5398278,5792597,6179114,6554217,6914625,7257469
13 DATA 7580363,7881446,8159399,8413447,8643339,8849303,9031995
14 DATA 9192433,9331928,9452007,9554345,9640697,9712834,9772499
15 DATA 9821356,9860966,9892759,9918025,9937903,9953388,9965330
16 DATA 9974449,9981342,9986501,9990324,9993129,9995166,9996631
17 DATA 9997674,9998409,9998922,9999277,9999519,9999683,9999793
18 DATA 9999867,9999915,9999946,9999966,9999979,9999987,9999992
19 DIM X(48)
20 DEF FNW(V)=(V-M)/S
21 DEF FNQ(V)=M+V*S
22 DEF FND(V)=X(V)-X(V-1)
23 DEF FNB(V)=U-V*(V-1)*(D2/(2*D1)+(V-2)*D3/(6*D1))
24 DEF FNT(V)=1-((V^2)+1)/(4*D)+(13*(V^2)^2+8*(V^2)+3)/(96*D^2)
25 DEF FNZ(V)=1+((V^2)+1)/(4*D)+(((V^2)+3)*(5*(V^2)+1))/(96*D^2)
100 GOTO 780
200 DATA 99
205 FOR I=0 TO 48
210 READ X(I)
215 NEXT I
220 READ D,M,S
225 PRINT
230 PRINT "   CALCULATIONS FOR A ";
235 IF D=0 THEN 250
240 PRINT "STUDENT'S T-";
245 GOTO 255
250 PRINT "NORMAL ";
255 PRINT "DISTRIBUTION"
260 PRINT "   HAVING A MEAN OF ";M;"AND A SIGMA OF ";S
265 IF D=0 THEN 275
270 PRINT "   AND HAVING ";D;"DEGREES OF FREEDOM."
275 PRINT
280 PRINT "CASE     THE PROBABILITY OF A VARIATE:"
285 PRINT
290 LET C=0
295 READ H
300 IF H=99 THEN 810
305 LET C=C+1
310 IF H=4 THEN 500
315 IF H=3 THEN 460
320 IF H=2 THEN 375
325 IF H=1 THEN 340
330 PRINT C;"   ERROR...ILLEGAL BLOCK TYPE SPECIFIED"
335 GOTO 810
340 READ V
345 LET B1=FNW(V)
350 IF D=0 THEN 360
355 LET B1=B1*FNT(B1)
360 GOSUB 545
365 PRINT C;"   EXCEEDING ";V;"IS";1-B2
370 GOTO 295
375 READ V1,V2
380 IF V1<V2 THEN 400
385 LET W=V1
390 LET V1=V2
395 LET V2=W
400 LET W1=FNW(V1)
405 LET W2=FNW(V2)
410 IF D=0 THEN 425
415 LET W1=W1*FNT(W1)
420 LET W2=W2*FNT(W2)
425 LET B1=W1
430 GOSUB 545
435 LET Q1=B2
440 LET B1=W2
445 GOSUB 545
450 PRINT C;"   BETWEEN ";V1;"AND ";V2;"IS";B2-Q1
455 GOTO 295
460 READ P
465 GOSUB 765
470 LET A1=1-P
475 GOSUB 615
480 IF D=0 THEN 490
485 LET A2=A2*FNZ(A2)
490 PRINT C;"   EXCEEDING ";FNQ(A2);"IS";P
495 GOTO 295
500 READ P
505 GOSUB 765
510 LET A1=0.5*(1+P)
515 GOSUB 615
520 IF D=0 THEN 530
525 LET A2=A2*FNZ(A2)
530 PRINT C;"   BETWEEN ";FNQ(-A2);"AND ";FNQ(A2);"IS";P
535 GOTO 295
540 REM  FIND PROB FOR A GIVEN NORMAL DEVIATE
545 IF B1<-4.5 THEN 600
550 IF B1<0 THEN 585
555 IF B1<4.5 THEN 570
560 LET B2=1
565 GOTO 605
570 GOSUB 660
575 LET B2=Q
580 GOTO 605
585 GOSUB 660
590 LET B2=1-Q
595 GOTO 605
600 LET B2=0
605 RETURN
610 REM  FIND NORMAL DEVIATE FOR A GIVEN PROB
615 IF A1>0.5 THEN 640
620 LET A1=1-A1
625 GOSUB 695
630 LET A2=-Q
635 GOTO 650
640 GOSUB 695
645 LET A2=Q
650 RETURN
655 REM  INTERPOLATE FOR NORMAL PROBABILITY
660 LET Z=10*ABS(B1)
665 LET K=INT(Z)
670 LET D1=Z-K
675 LET Q=X(K)+D1*FND(K+1)+(D1*(D1-1)/2)*(FND(K+2)-FND(K+1))
680 LET Q=1E-5*INT(5E-1+1E-2*Q)
685 RETURN
690 REM  REVERSE INTERPOLATE FOR NORMAL DEVIATE
695 LET Z=1E7*A1
700 FOR I=0 TO 45
705 IF Z<X(I) THEN 715
710 NEXT I
715 LET D1=FND(I)
720 LET E1=FND(I+1)
725 LET D2=E1-D1
730 LET D3=FND(I+2)-E1-D2
735 LET U=(Z-X(I-1))/D1
740 LET Q=FNB(FNB(U))
745 LET Q=0.1*(Q+I-1)
750 RETURN
755 PRINT C;"   MUST BE SPECIFIED IN RANGE 0.000005 TO 0.999995"
760 GOTO 295
765 IF P>1-5E-6 THEN 755
770 IF P<5E-6 THEN 755
775 RETURN
780 PRINT
785 PRINT "ENTER DATA INTO PROVAR*** AS FOLLOWS:"
790 PRINT
795 PRINT "   100 DATA  DF,MEAN,SIGMA,(BLOCK1),(BLOCK2),...."
800 PRINT
805 PRINT "LIST FILE PROVEX*** FOR DETAILED INSTRUCTIONS."
810 END