Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0113/cmod61.bas
There are 2 other files named cmod61.bas in the archive. Click here to see a list.
00020 MARGIN ALL 80
00030 DIM L(2),H(2),V(2),M(5,2)
00031REM**************************************************************
00032REM CMOD61 CMOD61 CMOD61 CMOD61 CMOD61
00033REM**************************************************************
00035 DIM X(1000),W(1000),S(12)
00040 FILES RFILE1,RFILE2,RFILE3,RF4,RF5,RF6,RF7,RF8,RF9
00041 RESTORE #9
00042 FOR I=1 TO 1000
00043 INPUT #9,X(I)
00044 INPUT #9,W(I)
00045 NEXT I
00046FOR I=1 TO 12
00047 INPUT #9,S(I)
00048 NEXT I
00049 INPUT #9,N0
00050 INPUT #9,V0
00051 INPUT #9,G6
00052 INPUT #9,M$
00053 INPUT #9,V$
00054 INPUT #9,G$
00070 G$=""
00080GOSUB 2320
00100GOSUB 7500
00110N2=0
00120N=0
00122G6=0
00130S4=0
00140S9=0
00145 DIM Z(12,7)
00150MAT Z=ZER
00155PRINT L$
00160PRINT " DATA GROUPING"
00170PRINT
00180PRINT "THIS MODULE ALLOWS YOU TO DIVIDE YOUR OBSERVATIONS INTO"
00190PRINT "GROUPS. THERE MUST BE LEAST ONE GROUP AND EACH GROUP MUST"
00194PRINT "HAVE AT LEAST ONE OBSERVATION. THE MAXIMUN NUMBER OF GROUPS"
00195PRINT "IS 12."
00200PRINT
00210PRINT "THERE ARE TWO WAYS TO IDENTIFY THE GROUPS."
00220PRINT " 1. THE GROUPS CAN BE IDENTIFIED ON THE BASIS OF "
00230PRINT " ONE OR TWO OF THE VARIABLES. SUPPOSE YOU HAVE"
00240PRINT " THE VARIABLES SEX AND IQ. YOU COULD FORM A"
00250PRINT " GROUP OF FEMALES WITH IQ'S ABOVE 110."
00260PRINT " 2. THE GROUPS CAN BE IDENTIFIED BY OBSERVATION"
00270PRINT " NUMBERS AS THEY APPEAR IN THE DATA EDITTING "
00280PRINT " MODULE."
00290GOTO 430
00300REM*****************************************************************
00310PRINT L$
00320PRINT "DATA SET = ";M$
00330PRINT
00340PRINT "HERE ARE THE VARIABLES IN YOUR DATA SET."
00350PRINT " NAME MINIMUM MAXIMUM MEAN ST. DEV"
00360FOR I2=1 TO V0
00370:##.'CCCCC#########.## #######.## #######.## #########.##
00375O1=I2*6-5
00380 PRINT USING 370,I2,MID$(V$,O1,I2*6-(O1)+1),M(I2,1),M(I2,2),A(I2),R(I2)
00390NEXT I2
00400PRINT
00410RETURN
00420REM*******************************************************************
00430PRINT
00440PRINT "VARIABLES=1 OBSERVATION NUMBERS=2 ";
00450GOSUB 9000
00460IF O1=1 THEN 500
00470IF O1=2 THEN 500
00480PRINT "REENTER. INPUT MUST BE NUMBER OF OPTION."
00490GOTO 450
00500I0=O1
00510PRINT L$
00520PRINT "IF YOU WANT THE GROUPS TO BE MUTUALLY EXCLUSIVE ( NO"
00530PRINT "OBSERVATION IN MORE THAN ONE GROUP ) YOU CAN SO INDICATE"
00540PRINT "AND THE MODULE WILL CHECK TO SEE THAT THIS CONDITION"
00550PRINT "IS MET. THE MODULE CAN ALSO CHECK TO SEE THAT THE GROUPS"
00560PRINT "ARE MUTUALLY EXCLUSIVE AND EXHAUSTIVE ( EACH OBSERVATION IN"
00570PRINT "ONE AND ONLY ONE GROUP )."
00580PRINT
00590PRINT "MUTUALLY EXCL.=1 MUTUALLY EXCL./ EXHAUST.=2 NEITHER=3";
00600GOSUB 9000
00610IF O1=1 THEN 660
00620IF O1=2 THEN 660
00630IF O1=3 THEN 660
00640PRINT "REENTER. INPUT MUST BE NUMBER OF OPTION."
00650GOTO 600
00660G9=O1
00670PRINT
00680PRINT "INPUT HOW MANY GROUPS YOU WANT TO FORM (MAX=12).";
00690GOSUB 9000
00700IF O1 <= 12 THEN 730
00710PRINT "REENTER. YOU MUST HAVE AT LEAST 1 AND NOT MORE THAN 12."
00720GOTO 690
00730IF O1 <> 0 THEN 750
00740CHAIN "CMOD10"
00750IF O1<1 THEN 710
00760G6=O1
00770PRINT
00780FOR I=1 TO G6
00790PRINT L$
00800IF I=1 THEN 840
00810PRINT "HERE IS A SUMMARY OF THE GROUPS FORMED SO FAR."
00820G7=I-1
00830GOSUB 1970
00840PRINT "INPUT NAME FOR GROUP ";I;" ";
00845 INPUT Z$
00850 G$=G$+RIGHT$(" "+Z$,6)
00860IF I0=2 THEN 1430
00870REM********** VARIABLE USED TO IDENTIFY **************************
00880PRINT L$
00890IF S4>1 THEN 950
00900S4=S4+1
00910PRINT "YOU CAN IDENTIFY THE GROUP MEMBERS BY THE VALUES OF ONE OR"
00920PRINT "TWO VARIABLES. FOR EACH VARIABLE YOU ARE TO INDICATE THE"
00930PRINT "RANGE OF VARIABLE VALUES THAT IDENTIFIES A GROUP MEMBER."
00940PRINT
00950GOSUB 340
00960PRINT "INPUT HOW MANY VARIABLES ARE TO BE USED TO IDENTIFY GROUP.";
00970GOSUB 9000
00980IF O1 >= 1 THEN 1010
00990PRINT "REENTER. YOU CAN IDENTIFY BY ONE OR TWO VARIABLES."
01000GOTO 970
01010IF O1>2 THEN 990
01020V6=O1
01030PRINT
01040FOR J=1 TO V6
01050PRINT "INPUT NUMBER OF VARIABLE ";J;" ";
01060GOSUB 9000
01070IF O1 >= 1 THEN 1100
01080PRINT "REENTER. NUMBER MUST BE VARIABLE NUMBER."
01090GOTO 1060
01100IF O1>V0 THEN 1080
01110V(J)=O1
01120NEXT J
01130PRINT
01140IF S4>1 THEN 1170
01150PRINT "SPECIFY THE RANGE OF VALUES THAT IDENTIFY A GROUP MEMBER."
01160PRINT "THE ENDPOINTS ARE CONSIDERED PART OF THE RANGE."
01170FOR J=1 TO V6
01180 PRINT "RANGE FOR ";MID$(V$,V(J)*6-5,V(J)*6-(V(J)*6-5)+1);" ";
01190GOSUB 9050
01200IF O2 >= O1 THEN 1230
01210PRINT "REENTER. INPUT SMALLER VALUE FIRST."
01220GOTO 1190
01230H(J)=O2
01240L(J)=O1
01250Z(I,(J-1)*3+1)=V(J)
01260Z(I,(J-1)*3+2)=O1
01270Z(I,(J-1)*3+3)=O2
01280NEXT J
01290FOR K=1 TO N0
01300FOR J=1 TO V6
01310IF X(K+N0*(V(J)-1))>H(J) THEN 1400
01320IF X(K+N0*(V(J)-1))<L(J) THEN 1400
01330NEXT J
01340IF G9=3 THEN 1380
01350FOR Z7=1 TO N
01360IF W(Z7)=K THEN 2460
01370NEXT Z7
01380N=N+1
01390W(N)=K
01400NEXT K
01410GOTO 1740
01420REM************* OBSERVATION NUMBERS USED TO IDENTIFY ************
01430PRINT L$
01440Z(I,1)=99
01450IF S9>1 THEN 1520
01460S9=S9+1
01470PRINT "IT IS ASSUMED THAT THE OBSERVATIONS YOU WANT IN THE GROUP ARE"
01480PRINT "IN BLOCKS OF CONSECUTIVELY NUMBERED OBSERVATIONS. YOU ARE TO"
01490PRINT "INPUT THE FIRST AND LAST NUMBER IN EACH BLOCK. IF A BLOCK IS"
01500PRINT "ONLY 1 OBSERVATION INPUT THE SAME NUMBER TWICE, E.G., '4,4'."
01510PRINT
01520PRINT "INPUT THE FIRST AND LAST NUMBER IN THE BLOCK (EXIT=0,0).";
01530GOSUB 9050
01540IF O1 <> 0 THEN 1560
01550IF O2=0 THEN 1740
01560IF O1 >= 1 THEN 1590
01570PRINT "REENTER. INPUT MUST BE OBSERVATION NUMBERS."
01580GOTO 1530
01590IF O2>N0 THEN 1570
01600IF O1 <= O2 THEN 1630
01610PRINT "REENTER. INPUT SMALLER NUMBER FIRST."
01620GOTO 1530
01630K0=O1
01640K1=O2
01650IF G9=3 THEN 1690
01652FOR K=K0 TO K1
01660FOR Z7=1 TO N
01670IF W(Z7)=K THEN 2460
01680NEXT Z7
01682NEXT K
01690FOR K=K0 TO K1
01700N=N+1
01710W(N)=K
01720NEXT K
01730GOTO 1520
01740S(I)=N-N2
01741IF S(I)=0 THEN 2235
01750N2=N
01760NEXT I
01770GOTO 1900
01780N1=0
01790SCRATCH#4
01791 REM
01792 PRINT #4,M$
01793 PRINT #4,G6
01794 PRINT #4,V0
01795 PRINT #4,CHR$(34);G$;CHR$(34)
01796 PRINT #4,CHR$(34);V$;CHR$(34)
01797 FOR I=1 TO 12
01798 PRINT #4,S(I)
01799 NEXT I
01800 REM
01810FOR I=1 TO G6
01820FOR J=1 TO V0
01830FOR K=1 TO S(I)
01840 PRINT#4,X(W(K+N1)+N0*(J-1))
01850 NEXT K
01860 NEXT J
01870 N1=N1+S(I)
01880 NEXT I
01890 CHAIN "CMOD10"
01900 G7=G6
01910 GOSUB 1940
01920 GOSUB 2130
01930 GOTO 2190
01940 PRINT L$
01950 PRINT " DESCRIPTION OF DATA SET"
01960 PRINT
01970 PRINT "GROUP N IDENTIFIER"
01980 FOR J=1 TO G7
01990 IF Z(J,1)=99 THEN 2090
02000 C$=MID$(V$,Z(J,1)*6-5,6)
02010 :'CCCCC ###### 'CCCCC= #########.## TO #########.##
02020 PRINT USING 2010,MID$(G$,J*6-5,6),S(J),C$,Z(J,2),Z(J,3)
02030 IF Z(J,4)=0 THEN 2100
02040 C$=MID$(V$,Z(J,4)*6-5,6)
02050 : 'CCCCC= #########.## TO #########.##
02060 PRINT USING 2050,C$,Z(J,5),Z(J,6)
02070 GOTO 2100
02080 :'CCCCC ##### BY OBSERVATION NUMBERS
02090 PRINT USING 2080,MID$(G$,J*6-5,6),S(J)
02100 NEXT J
02110 PRINT
02120 RETURN
02130 PRINT
02140 FOR J=1 TO V0
02150 :VARIABLE ##='CCCCC
02160 PRINT USING 2150,J,MID$(V$,J*6-5,6)
02170 NEXT J
02180 RETURN
02190 IF G6=0 THEN 2240
02200 IF G9<>2 THEN 2230
02205 IF N=N0 THEN 2290
02206 PRINT "NOTE THAT THE GROUPING IS NOT EXHAUSTIVE."
02210 PRINT "IF YOU WANT TO REGROUP TYPE '1', ELSE '0'.";
02212 GOSUB 9000
02214 IF O1=1 THEN 80
02216 IF O1=0 THEN 2290
02218 PRINT "REENTER. INPUT MUST BE 0 OR 1."
02219 GOTO 2212
02220
02230 GOTO 2290
02235 PRINT L$
02240 PRINT "THERE MUST BE AT LEAST ONE GROUP AND EACH GROUP MUST HAVE AT"
02241 PRINT "LEAST ONE OBSERVATION. YOU MUST EITHER RESPECIFY THE GROUPS"
02242 PRINT "OR WORK WITH UNGROUPED DATA."
02244 PRINT
02260 PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
02270 GOSUB 9000
02280 GOTO 80
02290 PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
02300 GOSUB 9000
02310 GOTO 1780
02320 FOR I=1 TO V0
02330 X2=-1.E+35
02340 X1=1.E+35
02350 FOR K5=1 TO N0
02360 I3=K5+I*N0-N0
02370 IF X(I3)<X2 THEN 2390
02380 X2=X(I3)
02390 IF X(I3)>X1 THEN 2410
02400 X1=X(I3)
02410 NEXT K5
02420 M(I,1)=X1
02430 M(I,2)=X2
02440 NEXT I
02450 RETURN
02460 PRINT L$
02470 PRINT "THE GROUPING HAS BEEN STOPPED BECAUSE THE CONDITION OF"
02480 PRINT "MUTUALLY EXCLUSIVE GROUPS WAS NOT MET."
02490 PRINT
02492 GOTO 1950
02495 PRINT
02500 PRINT "WHEN YOU ARE READY TO REGROUP TYPE '1'.";
02510 GOSUB 9000
02520 GOTO 110
07500 REM
07510
07530 MAT R=ZER
07540 MAT A=ZER
07550 FOR K6=1 TO V0
07560 FOR K5=1 TO N0
07570 I3=K5+K6*N0-N0
07640 R(K6)=R(K6)+X(I3)*X(I3)
07650 A(K6)=A(K6)+X(I3)
07660 NEXT K5
07662 R(K6)=SQR((R(K6)-A(K6)*A(K6)/N0)/N0)
07664 A(K6)=A(K6)/N0
07670 NEXT K6
07680 RETURN
07820 FOR I=N0 TO 2 STEP -1
07830 T0=Q(1)
07835 Q(1)=Q(I)
07840 Q(I)=T0
07860 L0=I-1
07870 I1=1
07880 C0=Q(1)
07890 J=I1*2
07900 IF J>L0 THEN 7980
07910 IF J>=L0 THEN 7940
07920 IF Q(J+1)<=Q(J) THEN 7940
07930 J=J+1
07940 IF Q(J)<= C0 THEN 7980
07950 Q(I1)=Q(J)
07960 I1=J
07970 GOTO 7890
07980 Q(I1)=C0
07990 NEXT I
08000 RETURN
09000 INPUT O1
09005 IF O1=-9999 THEN 9080
09008 RETURN
09050 INPUT O1,O2
09055 IF O2=-9999 THEN 9080
09060 IF O1=-9999 THEN 9080
09070 RETURN
09080 CHAIN "RSTRT"
09999 END