Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0113/cmod14.bas
There are 2 other files named cmod14.bas in the archive. Click here to see a list.
00030 DIM X(1000) ,E(12) ,H(5),L(5)
00040REM *************************************************************
00050REM CMOD14 CMOD14 CMOD14 CMOD14 CMOD14
00060REM **************************************************************
00070 FILES RFILE1,RFILE2,RFILE3,RF4,RF5,RF6,RF7,RF8,RF9
00080MAT G=ZER
00120RESTORE#1
00121 INPUT# 1,I1,I2,I3
00130SCRATCH#1
00131 PRINT # 1,45,I2,I3
00140Q9=0
00150 DIM M(5),S(5)
00160IF I2 <> 1 THEN 210
00170PRINT L$
00180PRINT " DATA GRAPHS AND TABULAR DISPLAYS"
00190SCRATCH#1
00191 PRINT # 1,I1,4,I3
00200CHAIN "CMOD30"
00210REM*---------------------------------------------------------
00220K0=1
00230GOSUB 8500
00240GOSUB 3470
00250Z0=0
00260PRINT L$
00270PRINT " DATA GRAPHS AND TABULAR DISPLAYS"
00280PRINT
00290PRINT " 1. ABSOLUTE FREQUENCY HISTOGRAMS"
00300PRINT " 2. BIVARIATE PLOTS"
00310PRINT " 3. TWO-WAY CONTINGENCY AND EXPECTANCY TABLES"
00320PRINT
00330PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT (EXIT=0).";
00340GOSUB 9000
00350IF O1=1 THEN 410
00360IF O1=3 THEN 500
00370IF O1=0 THEN 3420
00380IF O1=2 THEN 420
00390PRINT "REENTER. INPUT MUST BE NUMBER OF OPTION."
00400GOTO 340
00410CHAIN "CMOD43"
00420CHAIN "CMOD42"
00430K5=LOG(X0)/LOG(10)
00440RETURN
00450REM****************************************************
00460PRINT
00470PRINT "----------------------------------------"
00480PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
00490GOSUB 9000
00500PRINT L$
00510O3=O1
00520IF O3=3 THEN 530
00530PRINT " TWO-WAY CONTINGENCY TABLES"
00540PRINT
00550PRINT "EACH OF THE VARIABLES IN THE TWO-WAY CONTINGENCY TABLE"
00560GOTO 610
00570PRINT " TWO-WAY EXPECTANCY TABLES"
00580PRINT
00590PRINT "EACH OF THE VARIABLES IN THE TWO-WAY EXPECTANCY TABLE"
00600GOTO 610
00610PRINT "CAN BE DIVIDED INTO 2, 3 OR 4 CATEGORIES."
00620GOSUB 640
00630GOTO 780
00640PRINT
00650IF G6=0 THEN 680
00660 PRINT "DATA SET = ";M$;" GROUP = ";MID$(G$,J6*6-5,J6*6-(J6*6-5)+1)
00670GOTO 690
00680PRINT "DATA SET = ";M$
00690PRINT
00700PRINT "VARIABLES:"
00710FOR K5=1 TO V0
00720:"## = 'CCCCC"
00730SCRATCH#9
00731PRINT#9USING720,K5,MID$(V$,K5*6-5,6)
00732RESTORE#9
00733INPUT#9,Z$
00734PRINTZ$;
00740NEXT K5
00750PRINT
00760RETURN
00770GOTO 800
00780PRINT
00790GOTO 900
00800:INPUT THE NUMBER OF THE 'CCCCC VARIABLE YOU WANT
00810PRINT "TO HAVE IN THE CONTINGENCY TABLE (EXIT=0).";
00820GOSUB 9000
00830IF O1 <> 0 THEN 850
00840GOTO 260
00850IF O1 <= V0 THEN 880
00860PRINT "REENTER. INPUT MUST BE NUMBER OF VARIABLE."
00870GOTO 820
00880IF O1<1 THEN 860
00890RETURN
00900 X$=" FIRST"
00910PRINT USING 800,X$
00920GOSUB 800
00930K6=O1
00940V6=K6
00950 X$="SECOND"
00960PRINT USING 800,X$
00970GOSUB 800
00980K7=O1
00990V7=K7
01000GOSUB 1020
01010GOTO 1150
01020PRINT L$
01030 PRINT "VARIABLE = ";MID$(V$,K6*6-5,K6*6-(K6*6-5)+1)
01040PRINT
01050PRINT "MINIMUM=";L(K6)
01060PRINT "MAXIMUM=";H(K6)
01070PRINT
01075O1=K6*6-5
01080 PRINT "INPUT THE NUMBER OF CATEGORIES FOR ";MID$(V$,O1,K6*6-(O1)+1);
01090GOSUB 9000
01100IF O1 <= 4 THEN 1130
01110PRINT "REENTER. NUMBER MUST BE AT LEAST 2 BUT NOT MORE THAN 4."
01120GOTO 1090
01130IF O1<2 THEN 1110
01140RETURN
01150PRINT
01160I6=O1
01170K8=1
01180I0=I6+1
01190GOSUB 1210
01200GOTO 1700
01210IF Z0=1 THEN 1300
01220Z0=Z0+1
01230PRINT "YOU CAN EITHER SPECIFY THE CATEGORY BOUNDARIES OR LET THE"
01240PRINT "MODULE SET UP EQUAL LENGTH CATEGORIES ACROSS THE FULL RANGE"
01250PRINT "OF THE VARIABLE. ENTRIES EQUAL IN VALUE TO A COMMON BOUNDARY"
01260PRINT "WILL BE COUNTED AS A MEMBER OF THE CATEGORY WITH SMALLER"
01270PRINT "VALUES. ENTRIES EQUAL IN VALUE TO THE LOWER BOUNDARY OF THE"
01280PRINT "CATEGORY WITH THE SMALLEST VALUES WILL BE COUNTED AS A"
01290PRINT "MEMBER OF THAT CATEGORY."
01300PRINT
01310PRINT "LET MODULE SET UP CATEGORIES=1 YOU SPECIFY CATEGORIES=2 ";
01320GOSUB 9000
01330IF O1=2 THEN 1430
01340IF O1=1 THEN 1370
01350PRINT "REENTER. INPUT MUST BE NUMBER OF OPTION."
01360GOTO 1320
01370I(K8,1)=L(K6)-1.E-07
01380FOR K9=2 TO I0-1
01390I(K8,K9)=L(K6)+(K9-1)*(H(K6)-L(K6))/(I0-1)
01400NEXT K9
01410I(K8,I0)=H(K6)+1.E-07
01420RETURN
01430GOSUB 1450
01440RETURN
01450REM
01460PRINT"CATEGORY 1 LOWER BOUNDARY";
01470GOSUB 9000
01480I(K8,1)=O1-1.E-07
01490REM
01500PRINT" UPPER BOUNDARY";
01510GOSUB 9000
01520IF O1>I(K8,1) THEN 1570
01530GOSUB 1550
01540GOTO 1460
01550PRINT "REENTER. ENTER LOWER FIRST."
01560RETURN
01570I(K8,2)=O1
01580PRINT
01590K5=2
01600FOR K9=3 TO I0
01610PRINT "CATEGORY ",K5;" LOWER="I(K8,K9-1);" UPPER=";
01620GOSUB 9000
01630IF O1>I(K8,K9-1) THEN 1660
01640GOSUB 1550
01650GOTO 1610
01660I(K8,K9)=O1
01670K5=K5+1
01680NEXT K9
01690RETURN
01700S6=K6
01710K6=K7
01720GOSUB 1020
01730I7=O1
01740PRINT
01750K8=2
01760I0=I7+1
01770GOSUB 1210
01780K6=S6
01790MAT G=ZER
01800FOR K5=1 TO N0
01810K8=K6
01820I0=1
01830I4=I6
01840GOSUB 1940
01850I1=I3
01860K8=K7
01870I0=2
01880I4=I7
01890GOSUB 1940
01900I2=I3
01910IF I1=0 THEN 2040
01920IF I2=0 THEN 2040
01930GOTO 2030
01940REM***************************************************
01950IF X(K5+K8*N0-N0)<I(I0,1) THEN 2010
01960IF X(K5+K8*N0-N0)>I(I0,I4+1) THEN 2010
01970I3=1
01980IF X(K5+K8*N0-N0) <= I(I0,I3+1) THEN 2020
01990I3=I3+1
02000GOTO 1980
02010I3=0
02020RETURN
02030G(I1,I2)=G(I1,I2)+1
02040NEXT K5
02050PRINT L$
02060P4=5*I7+7
02070FOR K5=1 TO P4
02080REM
02090PRINT"-";
02100NEXT K5
02110:"'CCCCC"
02120SCRATCH#9
02121PRINT#9USING2110,MID$(V$,V7*6-5,6)
02122RESTORE#9
02123INPUT#9,Z$
02124PRINTZ$;
02130FOR K5=P4+7 TO I7*10+20
02140PRINT"-";
02150NEXT K5
02160PRINT
02170IF O3=3 THEN 2220
02180REM
02190PRINT"I PERCENT I";
02200GOTO 2230
02210REM
02220PRINT"I FREQUENCYI";
02230:"## I"
02240FOR K6=1 TO I7
02250:"######.##I"
02260SCRATCH#9
02261PRINT#9USING2250,I(2,K6)
02262RESTORE#9
02263INPUT#9,Z$
02264PRINTZ$;
02270NEXT K6
02280PRINT "I ROW I"
02290PRINT"I";
02300REM
02310PRINT" I";
02320FOR K6=1 TO I7
02330SCRATCH#9
02331PRINT#9USING2250,I(2,K6+1)
02332RESTORE#9
02333INPUT#9,Z$
02334PRINTZ$;
02340NEXT K6
02350PRINT"I TOTALS I"
02360PRINT"I";
02370:"--'CCCCC--I"
02380SCRATCH#9
02381PRINT#9USING2370,MID$(V$,V6*6-5,V6*6-(V6*6-5)+1)
02382RESTORE#9
02383INPUT#9,Z$
02384PRINTZ$;
02390FORI0=1TOI7
02400REM
02410PRINT"---------I";
02420NEXT I0
02430PRINT "I--------I"
02440FOR K5=1 TO I6
02450PRINT"I";
02460:"######.## I"
02470SCRATCH#9
02471PRINT#9USING2460,I(1,K5)
02472RESTORE#9
02473INPUT#9,Z$
02474PRINTZ$;
02480FOR I1=1 TO I7
02490REM
02500PRINT" I";
02510NEXT I1
02520PRINT "I I"
02530PRINT"I";
02540SCRATCH#9
02541PRINT#9USING2460,I(1,K5+1)
02542RESTORE#9
02543INPUT#9,Z$
02544PRINTZ$;
02550T0=0
02560FOR K6=1 TO I7
02570:"####### "
02580SCRATCH#9
02581PRINT#9USING2570,G(K5,K6)
02582RESTORE#9
02583INPUT#9,Z$
02584PRINTZ$;
02590T0=T0+G(K5,K6)
02600:IMAGE"I"
02610PRINT"I";
02620NEXT K6
02630:"I###### I"
02640SCRATCH#9
02641PRINT#9USING2630,T0
02642RESTORE#9
02643INPUT#9,Z$
02644PRINTZ$
02650PRINT"I";
02660FOR I0=1 TO I7+1
02670IF K5 <> I6 THEN 2730
02680REM
02690IF I0 <> 1 THEN 2710
02700PRINT "=";
02710PRINT"=========I";
02720GOTO 2760
02730IF I0 <> 1 THEN 2750
02740PRINT "-";
02750PRINT"---------I";
02760NEXT I0
02770IF K5 <> I6 THEN 2800
02780PRINT "I========I"
02790GOTO 2810
02800PRINT "I--------I"
02810NEXT K5
02820REM
02830PRINT"I";
02840PRINT" COLUMN ";
02850PRINT"I";
02860FOR K5=1 TO I7
02870PRINT" I";
02880NEXT K5
02890PRINT "I I"
02900PRINT"I";
02910REM
02920PRINT" TOTALS ";
02930PRINT"I";
02940T1=0
02950FOR K5=1 TO I7
02960T0=0
02970FOR K6=1 TO I6
02980T0=T0+G(K6,K5)
02990NEXT K6
03000:"####### I"
03010SCRATCH#9
03011PRINT#9USING3000,T0
03012RESTORE#9
03013INPUT#9,Z$
03014PRINTZ$;
03020T1=T1+T0
03030NEXT K5
03040IF Q9>0 THEN 3060
03050Q9=T1
03060SCRATCH#9
03061PRINT#9USING2630,T1
03062RESTORE#9
03063INPUT#9,Z$
03064PRINTZ$
03070FOR K5=1 TO I7+2
03080REM
03090PRINT"----------";
03100NEXT K5
03110PRINT
03120PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
03130GOSUB 9000
03140PRINT L$
03150IF O3=3 THEN 3190
03160REM
03170O1=3
03180GOTO 500
03190PRINT "IF YOU WANT THE EXPECTANCY TABLE TYPE '1' ELSE '0'.";
03200GOSUB 9000
03210IF O1=0 THEN 3160
03220IF T1 <> 0 THEN 3290
03230PRINT " SINCE YOU HAVE A TOTAL OF ZERO OBSERVATIONS, YOU MAY NOT GET"
03240PRINT "AN EXPECTANCY TABLE."
03250PRINT
03260PRINT "WHEN YOU ARE READY TO CONTINUE TYPE'1'.";
03270GOSUB 9000
03280GOTO 3170
03290O3=4
03300FOR K5=1 TO I6
03310FOR K6=1 TO I7
03320G(K5,K6)=100*G(K5,K6)/Q9
03330NEXT K6
03340NEXT K5
03350GOTO 2050
03360GOTO 500
03370M(K5)=M(K5)/N0
03380REM
03390I5=3
03400REM*******************************************LIS
03410GOTO 500
03420SCRATCH#6
03421PRINT#6,L1$,0
03430IF G6=0 THEN 3450
03440GOTO 80
03450CHAIN "CMOD10"
03460REM------------------- MIN MAX FINDER --------------------------
03470FOR X1=1 TO V0
03480H0=-1.E+35
03490L0=1.E+35
03500FOR K5=1 TO N0
03510X2=X(K5+X1*N0-N0)
03520IF X2<H0 THEN 3540
03530H0=X2
03540IF X2>L0 THEN 3560
03550L0=X2
03560NEXT K5
03570H(X1)=H0
03580L(X1)=L0
03590NEXT X1
03600RETURN
08490REM---------- READ IN TEMPORARY DATA FILE
08500REM
08510RESTORE#6
08511 INPUT#6,L1$,J6
08520RESTORE#4
08521 INPUT# 4,M$,G6,V0,G$,V$
08522FORI=1TO12
08523INPUT#4,E(I)
08524NEXTI
08530IF J6 <> 0 THEN 8700
08540PRINT L$
08550IF G6=0 THEN 8840
08560PRINT "HERE ARE THE GROUPS IN YOUR DATA SET."
08570FOR J=1 TO G6
08580:## = 'CCCCC
08590 PRINT USING 8580,J,MID$(G$,J*6-5,J*6-(J*6-5)+1)
08600NEXT J
08610PRINT
08620PRINT "INPUT THE NUMBER OF THE GROUP YOU WANT (NONE=0)";
08630GOSUB 9000
08640IF O1=0 THEN 8920
08650IF O1 <= G6 THEN 8670
08660PRINT "REENTER. INPUT MUST BE NUMBER OF A GROUP OR 0."
08662GOTO 8630
08670IF O1<1 THEN 8660
08675REM
08680J6=O1
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)
08842J6=0
08880FOR J=1 TO N0*V0
08890 INPUT#4,X(J)
08900NEXT J
08905SCRATCH#6
08906 PRINT#6,L1$,J6
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
09999END