Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0025/destat.bas
There are 2 other files named destat.bas in the archive. Click here to see a list.
10   DIMX(333),C(50),E(50),G(50),F(50)
20   PRINT
21   PRINT"MODIFIED 06/08/1968"
22   PRINT
50   LETS1=0
75   LETS2=0
100   LETS3=0
120   LETI=0
150   LETI=I+1
190   READX(I)
200	GO TO 1550
300   DATA 1E37
310   IFX(I)<>1E37THEN330
320   IFX(I)=1E37THEN399
330   LETY1=X(I)
340   LETY2=Y1*Y1
350   LETY3=Y1*Y2
360   LETS1=S1+Y1
370   LETS2=S2+Y2
380   LETS3=S3+Y3
390   GOTO150
399   READ W1,W2
400   DATA 5,5
404   LETN=I-1
405   LETE(0)=S1
410   LETY1=S1/N
415   LETY2=S2/N
420   LETY3=S3/N
425   LETS2=Y2-Y1^2
430   LETS3=Y3-3*Y1*Y2+2*Y1^3
435   LETC1=S2*I/N
440   LETC2=SQR(C1)
445   LETY2=SQR(S2)
450   LETY3=S3/(S2*Y2)
455   IFABS(Y3)<0.0001THEN460
456   IFABS(Y3)<>0.001THEN470
460   LETY3=0
470   PRINT"  S U M M A R Y   S T A T I S T I C S"
475   PRINT
476   PRINT"    NUMBER OF VARIATES = ";N
477   PRINT"       ARITHMETIC MEAN = ";Y1
478   PRINT"    STANDARD DEVIATION = ";Y2
479   PRINT"              VARIANCE = ";S2
480   PRINT"      EST TRUE STD DEV = ";C2
481   PRINT"     EST TRUE VARIANCE = ";C1
482   PRINT"              SKEWNESS = ";Y3
483   PRINT
484   PRINT"   TYPE '7' FOR MORE OUTPUT, OR '3' TO STOP NOW.  WHICH";
485   INPUT K1
486   IFK1<>7THEN1999
487 FOR I=0 TO N-2
488 FOR J=I+1 TO N-1
489   IFX(I)<X(J)THEN493
490   LETY1=X(I)
491   LETX(I)=X(J)
492   LETX(J)=Y1
493   NEXTJ
494   NEXTI
495   LETP=1
500   DATA 1
505   LETP=3E15
506   DATA 1,199
511   PRINT
515   PRINT"   O R D E R   S T A T I S T I C S"
520   PRINT
525   PRINT"     SMALLEST VARIATE = ";X(0)
530   LETC=10
535   LETZ=T1
540   GOSUB1500
545   LETT1=Z
550   PRINT"         LOWER DECILE = ";T1
555   LETC=25
560   LETZ=T2
565   GOSUB1500
570   LETT2=Z
575   PRINT"       FIRST QUARTILE = ";T2
580   LETC=50
585   LETZ=T3
590   GOSUB1500
595   LETT3=Z
600   PRINT"               MEDIAN = ";T3
605   LETC=75
610   LETZ=T4
615   GOSUB1500
620   LETT4=Z
625   PRINT"       THIRD QUARTILE = ";T4
630   LETC=90
635   LETZ=T5
640   GOSUB1500
645   LETT5=Z
650   PRINT"         UPPER DECILE = ";T5
655   PRINT"      LARGEST VARIATE = ";X(N-1)
660   PRINT
665 LET S1=X(N-1)-X(0)
670   LETS2=T5-T1
675   LETS3=0.5*(T4-T2)
680   PRINT"          TOTAL RANGE = ";S1
685   PRINT"         DECILE RANGE = ";S2
690   PRINT"     SEMI-INT-Q RANGE = ";S3
695   PRINT
700   IFP=3E15THEN795
705   PRINT"  O T H E R   P E R C E N T I L E S"
710   PRINT
715   READP
720   IFP=199THEN795
725   IFP=0THEN715
730   IFP=10THEN715
735   IFP=25THEN715
740   IFP=50THEN715
745   IFP=75THEN715
750   IFP=90THEN715
755   IFP=100THEN715
760   LETC=P
765   LETZ=V
770   GOSUB1500
775   LETP=C
780   LETV=Z
785   PRINT" ",P,V
790   GOTO715
795   LETL=1
800   LETD=W2-W1
805 LET U=X(N-1)-X(0)
810   IFD<>0THEN915
815   LETL=0
820   LETM=1+LOG(N)/LOG(2)
825   LETD=U/M
830   LETS1=LOG(D)/LOG(10)
835   LETP=INT(S1)
840   LETT1=S1-P
845   LETY1=EXP(P*LOG(10))
850   IFT1<0.2THEN870
855   IFT1<0.6THEN880
860   IFT1<0.9THEN890
865   IFT1>=0.9THEN900
870   LETK1=1
875   GOTO905
880   LETK1=2
885   GOTO905
890   LETK1=5
895   GOTO905
900   LETK1=10
905   LETD=K1*Y1
915   IFL<>0THEN935
920 LET Y1=(INT(X(0)/D)-1)*D
925 LET Y2=(INT(X(N-1)/D)+2)*D
930   GOTO965
935 IF W1>X(0)-D THEN 950
940   LETY1=W1
945   GOTO960
950 LET L=2+INT((W1-X(0))/D)
955   LETY1=W1-L*D
960   LETY2=Y1+D*(3+INT(U/D))
965   LETL=ABS((Y2-Y1)/D)
970   IFL>50THEN1995
975   LETC(0)=Y1
980   LETC(L)=Y2
985   LETF(L)=0
990   LETE(L)=0
995   FORI=1TOL-1
1000   LETC(I)=C(I-1)+D
1005   LETF(I)=0
1010   LETE(I)=0
1015   NEXTI
1020   PRINT
1025   PRINT"  F R E Q U E N C Y   D I S T R I B U T I O N"
1030   PRINT
1035   PRINT"             UP TO BUT"," ","PERCENT"
1040   PRINT"FROM        NOT INCLUDING   FREQUENCY","FREQUENCY"
1045   PRINT
1050 FOR I=0 TO N-1
1055   LETH=INT(1.00001*(X(I)-C(0))/D)+1
1060   LETF(H)=F(H)+1
1065   LETE(H)=E(H)+X(I)
1070   NEXTI
1075   FORJ=1TOL
1080   LETG(J)=100*F(J)/N
1095   PRINT C(J-1),C(J),F(J),G(J)
1100   NEXTJ
1105   FORJ=2TOL
1110   LETF(J)=F(J-1)+F(J)
1115   LETG(J)=100*F(J)/N
1120   LETE(J)=E(J-1)+E(J)
1125   NEXTJ
1130   PRINT
1135   PRINT"  C U M U L A T I V E   D I S T R I B U T I O N"
1140   PRINT
1145   PRINT"            NUMBER LESS   PERCENT LESS   VARIATE SUM - PCT"
1150   PRINT" VALUE      THAN VALUE    THAN VALUE     LESS THAN VALUE"
1155   PRINT
1160   FORJ=1TOL-1
1165   LETE(J)=100*E(J)/E(0)
1170   PRINT C(J),F(J),G(J),E(J)
1175   NEXTJ
1180   PRINT
1185   PRINT"  O R D E R E D   A R R A Y"
1186   PRINT
1187   LETM=INT(N/4-0.05)+1
1188   LETH=4*(M-1)
1189   LETL=N-H
1190 FOR I=0 TO M-1
1195   LETK1=I+M
1200   IFL=1THEN1215
1205   LETK2=I+2*M
1210   GOTO1225
1215   LETK2=I+2*M-1
1225   IFL=1THEN1245
1230   IFL=2THEN1245
1235   LETK3=I+3*M
1236 IF K3=N THEN 1260
1240   GOTO1250
1245   LETK3=I+3*M-2/L
1246 IF K3=N THEN 1260
1250   PRINT X(I),X(K1),X(K2),X(K3)
1255   NEXTI
1260   FORI=1TOL
1265 PRINT X(I*M-1),
1275   NEXTI
1280   GOTO1999
1500   LETG=C*(N+1)/100
1505   LETQ=INT(G)
1510   LETH=G-Q
1515   IFQ=NTHEN1530
1520 LET Z=H*X(Q)+(1-H)*X(Q-1)
1525   RETURN
1530 LET Z=X(N-1)
1535   RETURN
1550   PRINT
1600   PRINT"LIST 'DESTEX*' FOR INSTRUCTIONS ON USING THIS PROGRAM."
1605   GOTO1999
1995   PRINT"LIMIT IS 50 CLASSES....INCREASE CLASS WIDTH AND RERUN."
1999   END