Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50422/cmod43.bas
There are 2 other files named cmod43.bas in the archive. Click here to see a list.
00030 DIM X(1000) ,E(12)
00040FILES RFILE1,RFILE2,RFILE3,RF4,RF5,RF6,RF7,RF8,RF9
00080REM ******************************************************************
00090REM CMOD43 CMOD43 CMOD43 CMOD43 CMOD43 CMOD43
00100REM *****************************************************************
00110GOSUB 8500
00120MAT G=ZER
00130 DIM M(5),S(5)
00150 DIM I(19)
00160 B$=" "
00170 K$="0123456789"
00180S0=0
00190V9=0
00200V7=1
00210K0=1
00220 A$="========================================"
00230S0=1
00240GOTO 260
00250CHAIN "CMOD14"
00260PRINT L$
00270PRINT " HISTOGRAMS"
00280PRINT
00290PRINT "THIS MODULE DRAWS ABSOLUTE FREQUENCY HISTOGRAMS FOR THE"
00300PRINT "VARIABLE YOU SPECIFY."
00310PRINT
00320IF G6=0 THEN 350
00330 PRINT "DATA SET = ";M$;" GROUP = ";MID$(G$,J6*6-5,J6*6-(J6*6-5)+1)
00340GOTO 360
00350PRINT "DATA SET = ";M$
00360PRINT
00370PRINT "VARIABLES"
00380FOR K5=1 TO V0
00390:"##='LLLLL "
00395 SCRATCH #9
00400PRINT#9 USING 390,K5,MID$(V$,K5*6-5,K5*6-(K5*6-5)+1)
00402RESTORE#9
00403INPUT#9,D1$
00404PRINTD1$;
00410NEXT K5
00420PRINT " "
00430PRINT
00440PRINT "INPUT THE NUMBER OF THE VARIABLE FOR WHICH YOU WANT AN"
00450PRINT "HISTOGRAM (NONE=0).";
00460GOSUB 9000
00470O1=INT(O1)
00480IF O1=0 THEN 250
00490Q5=0
00500IF O1 <= V0 THEN 530
00510PRINT "REENTER. INPUT MUST BE 0 OR NUMBER OF VARIABLE."
00520GOTO 460
00530IF O1<1 THEN 510
00540K8=O1
00550GOSUB 2290
00560PRINT L$
00570:MINIMUM VALUE FOR 'CCCCC =########.###
00580 PRINT USING 570,MID$(V$,K8*6-5,K8*6-(K8*6-5)+1),X1
00590:MAXIMUM VALUE FOR 'CCCCC =########.###
00600 PRINT USING 590,MID$(V$,K8*6-5,K8*6-(K8*6-5)+1),X2
00610K6=K8
00620PRINT
00630PRINT "INPUT THE NUMBER OF INTERVALS YOU WANT(MAX=15).";
00640GOSUB 9000
00650O1=INT(O1)
00660IF O1 <= 15 THEN 690
00670PRINT "REENTER. MINUMIN=2. MAXIMUM=15."
00680GOTO 640
00690IF O1<2 THEN 670
00700M6=O1
00710PRINT
00720IF V9=1 THEN 820
00730PRINT "YOU CAN EITHER SPECIFY THE INTERVALS OR LET THE MODULE"
00740PRINT "DIVIDE THE RANGE INTO EQUAL LENGTH INTERVALS. VALUES"
00750PRINT "EQUAL TO AN INTERVAL BOUNDARY ARE ASSIGNED TO THE INTERVAL"
00760PRINT "WITH THE LARGER VALUES."
00770PRINT
00780PRINT "IF YOU WANT TO LET THE MODULE DO IT TYPE '1'."
00790PRINT "IF YOU WANT TO SPECIFY THE INTERVALS TYPE '2'."
00800V9=1
00810PRINT
00820PRINT "DO NOT SPECIFY INTERVALS=1 SPECIFY INTERVALS=2 ";
00830GOSUB 9000
00840C7=O1
00850IF O1=1 THEN 890
00860IF O1=2 THEN 910
00870PRINT "REENTER. INPUT MUST BE 1 OR 2."
00880GOTO 830
00890K8=K6
00900GOTO 1120
00910PRINT L$
00920PRINT "YOU ARE TO SPECIFY THE LOWER AND UPPER BOUNDARIES OF THE"
00930PRINT "INTERVALS."
00940PRINT
00950PRINT "INTERVAL 1 LOWER";
00960GOSUB 9000
00970I(1)=O1
00980PRINT " UPPER";
00990GOSUB 9000
01000IF O1>I(1) THEN 1030
01010PRINT "REENTER. UPPER MUST BE GREATER THAN LOWER."
01020GOTO 950
01030I(2)=O1
01040FOR K5=3 TO M6+1
01050PRINT "INTERVAL";K5-1;" LOWER=";I(K5-1);" UPPER";
01060GOSUB 9000
01070IF O1>I(K5-1) THEN 1100
01080PRINT "REENTER. UPPER MUST BE LARGER THAN LOWER."
01090GOTO 1060
01100I(K5)=O1
01110NEXT K5
01120PRINT L$
01140 PRINT USING 1141,MID$(V$,K6*6-5,K6*6-(K6*6-5)+1)
01141: ABSOLUTE FREQUENCY HISTOGRAM OF 'CCCC
01150PRINT "-----------------------------------------------------------"
01160PRINT " INTERVAL I ABSOLUTE FREQUENCY"
01170PRINT "------------------I---------1---------2---------3---------4"
01180K0=1
01190REM C7=1 IF YOU DID NOT SPECIFY THE INTERVALS
01200IF C7=1 THEN 1250
01210L0=ABS(I(M6+1))
01220IF ABS(I(M6))<L0 THEN 1300
01230L0=ABS(I(M6))
01240GOTO 1300
01250L0=ABS(X2)
01260IF L0>ABS(X1) THEN 1280
01270L0=ABS(X1)
01280S6=(X2-X1)/M6
01290REM********* DETERMINE PRINT FORMAT *****************
01300K3=1
01310IF L0<10**(K3-1) THEN 1360
01320IF K3=6 THEN 1350
01330K3=K3+1
01340GOTO 1310
01350K3=7
01360IF C7=1 THEN 1470
01370FOR K2=1 TO M6
01380K5=I(K2)
01390K7=I(K2+1)
01400IF K2 <> M6 THEN 1420
01410K7=K7+.000001
01420S6=K7-K5
01430GOTO 1780
01440NEXT K2
01450GOTO 2210
01460V7=1
01470FOR K5=X1 TO X2-.9*S6 STEP S6
01480IF K5<X2-1.5*S6 THEN 1780
01490Q5=1
01500K7=1.2*S6+K5
01510GOTO 1800
01520REM****************** PRINT ROUTINE **************
01530 P$=P$+" "
01532 P$=LEFT$(P$,40)
01535IF K3=7 THEN 1740
01540 ONK3 GOTO 1550,1580,1610,1640,1670,1700
01550:#.##### I##.##### I'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
01560PRINT USING 1550,K5,K5+S6,P$
01570GOTO 1760
01580:##.#### I###.#### I'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
01590PRINT USING 1580,K5,K5+S6,P$
01600GOTO 1760
01610:###.### I####.### I'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
01620PRINT USING 1610,K5,K5+S6,P$
01630GOTO 1760
01640:####.## I#####.## I'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
01650PRINT USING 1640,K5,K5+S6,P$
01660GOTO 1760
01670:#####.# I######.# I'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
01680PRINT USING 1670,K5,K5+S6,P$
01690GOTO 1760
01700:####### I######## I'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
01710PRINT USING 1700,K5,K5+S6,P$
01720GOTO 1760
01730STOP
01740:##.#^^^^I ##.#^^^^I'LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
01750 PRINT USING 1740,K5,K5+S6,P$
01760 GOTO 2180
01780 Q5=0
01790 K7=K5+S6
01800 K9=0
01810 K0=1
01820 I3=K0+K6*N0-N0
01830 IF Q5=1 THEN 1860
01840 IF X(I3)>=K7 THEN 1890
01850 GOTO 1870
01860 IF X(I3)>K7 THEN 1890
01870 IF X(I3)<K5 THEN 1890
01880 K9=K9+1
01890 IF K0=N0 THEN 1920
01900 K0=K0+1
01910 GOTO 1820
01920 P$=""
01930 IF K9>40 THEN 2060
01940 IF K9<10 THEN 1990
01950 O1=INT(K9/10+1)
01960 P$=P$+MID$(A$,1,K9-2)
01970 P$=P$+MID$(K$,O1,1)
01980 GOTO 2020
01990 IF K9=0 THEN 1530
02000 IF K9=1 THEN 2020
02010 P$=P$+MID$(A$,1,K9-1)
02020 I3=K9-10*INT(K9/10)+1
02030 P$=P$+MID$(K$,I3,1)
02040 GOTO 1530
02060 P$=P$+MID$(A$,1,37)
02070 IF K9>99 THEN 2130
02072 P$=P$+MID$(A$,1,1)
02080 I3=INT(K9/10)+1
02090 P$=P$+MID$(K$,I3,1)
02100I3=K9-10*INT((K9/10))+1
02110 P$=P$+MID$(K$,I3,1)
02120 GOTO 1530
02130 I3=INT(K9/100)+1
02140 P$=P$+MID$(K$,I3,1)
02150 K9=K9-100*INT(K9/100)+1
02160 GOTO 2080
02170 PRINT
02180 V7=0
02190 IF C7=2 THEN 1440
02200 NEXT K5
02210PRINT"------------------I---------1---------2---------3---------4"
02220PRINT"WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
02230 GOSUB 9000
02240PRINT L$
02250PRINT" HISTOGRAMS"
02260 GOTO 310
02270 M(K5)=M(K5)/N0
02280REM
02290 X1=1.E35
02300X2=-1E35
02310 FOR K5=1 TO N0
02320 I3=K5+K8*N0-N0
02330 IF X(I3)<X2 THEN 2350
02340 X2=X(I3)
02350 IF X(I3)>X1 THEN 2370
02360 X1=X(I3)
02370 NEXT K5
02380RETURN
08490REM---------- READ IN TEMPORARY DATA FILE
08500 REM
08510RESTORE#6
08511 INPUT# 6 ,L1$,J6
08512RESTORE#4
08513INPUT#4,M$
08514INPUT#4,G6
08515INPUT#4,V0
08516INPUT#4,G$
08517INPUT#4,V$
08518FOR I=1 TO 12
08519INPUT#4,E(I)
08520NEXT I
08530IF J6 <> 0 THEN 8700
08550IF G6=0 THEN 8840
08700N0=0
08710N1=0
08720FOR J=1 TO J6-1
08730N1=N1+E(J)
08750NEXT J
08760FOR J=1 TO N1*V0
08765 INPUT#4,O1
08766NEXT J
08820N0=E(J6)
08830GOTO 8880
08840N0=E(1)
08880FOR J=1 TO N0*V0
08890 INPUT#4,X(J)
08900NEXT J
08910RETURN
08920CHAIN "CMOD10"
09000REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
09005INPUT O1
09015IF O1=-9999 THEN 9025
09020RETURN
09025CHAIN "RSTRT"
09035REM*************END ROUTINE
09050REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED. 2 INPUTS
09055INPUT O1,O2
09065IF O1=-9999 THEN 9080
09070IF O2=-9999 THEN 9080
09075RETURN
09080CHAIN "RSTRT"
09090REM*************END ROUTINE
09999 END