Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0113/cmod71.bas
There are 2 other files named cmod71.bas in the archive. Click here to see a list.
00030 DIM W(1000),L(2,5),H(2,5)
00031DIMX(1000)
00032REM****************************************************************
00033REM CMOD71 CMOD71 CMOD71 CMOD71 CMOD71
00034REM****************************************************************
00035 MARGIN ALL 80
00040 N$="12345"
00060FILES RFILE1,RFILE2,RFIL3, , , , , ,RF9
00061RESTORE#9
00062INPUT#9,N0
00063INPUT#9,V0
00064FORI=1TON0*V0
00065INPUT#9,X(I)
00066NEXTI
00067INPUT#9,V$
00100RESTORE#1
00101 INPUT# 1,I1,I2,I3
00110SCRATCH#1
00111 PRINT # 1,46,I2,I3
00120W0=0
00130H0=1.E+35
00140L0=1.E+35
00150B0=0
00160W2=0
00170MAT W=CON
00180S9=0
00190PRINT L$
00200PRINT " DATA TRANSFORMATIONS"
00210PRINT
00220PRINT "THIS MODULE ALLOWS YOU TO CREATE A WORKING DATA SET FROM AN"
00230PRINT "EXISTING DATA SET WHICH WILL BE REFERRED TO AS THE SOURCE SET."
00240PRINT "THE WORKING DATA SET IS CREATED BY PERFORMING TRANSFORMATIONS"
00250PRINT "ON THE VARIABLES OF THE SOURCE SET OR PREVIOUSLY CREATED"
00260PRINT "VARIABLES OF THE WORKING SET."
00270PRINT
00280PRINT
00290PRINT "ONLY THE WORKING SET WILL BE PASSED TO THE NEXT MODULE"
00300PRINT "UPON EXIT FROM THIS MODULE. THEREFORE IF YOU WANT TO "
00310PRINT "HAVE YOUR SOURCE SET FOR FUTURE WORK AND IT HAS NOT"
00320PRINT "PREVIOUSLY BEEN FILED YOU SHOULD DO SO AT THIS TIME."
00330PRINT
00340PRINT "IF YOU WANT TO FILE YOUR SOURCE SET TYPE '1' ELSE '0'.";
00350GOSUB 9000
00360IF O1 <> 1 THEN 410
00370CHAIN "CMOD17"
00380IF O1=0 THEN 490
00390PRINT "REENTER. INPUT MUST BE 0 OR 1."
00400GOTO 350
00410PRINT L$
00411O0=7
00412O9=7
00420GOSUB 3790
00430PRINT "IF YOU WANT TO TRANSFER ANY SOURCE VARIABLES DIRECTLY TO"
00440PRINT "THE WORKING SET TYPE '1', ELSE '0'.";
00450GOSUB 9000
00460IF O1=0 THEN 490
00470IF O1=1 THEN 770
00480PRINT "REENTER. INPUT MUST BE 0 OR 1."
00482GOTO 450
00490PRINT L$
00500PRINT "HERE IS A LIST OF THE AVAILABLE TRANSFORMATIONS."
00505PRINT
00506O9=0
00510PRINT " 1. LINEAR FUNCTION OF ONE OR TWO VARIABLES Y=AX+BZ+C"
00520PRINT " 2. POWER FUNCTION Y=A(X**B)+C"
00530PRINT " 3. NATURAL LOG Y=A*LOG(X+B)+C"
00540PRINT " 4. STANDARDIZE Y=(X-X.)/SIGMA X"
00550PRINT " 5. LOG-ODDS Y=LOG((X-A)/(B-X))"
00560PRINT " 6. FREEMAN-TUKEY ARCSIN"
00570PRINT " 7. IDENTITY Y=X"
00580PRINT
00590PRINT "NOTE: * MULTIPLICATION ** RAISE TO A POWER"
00600PRINT
00610PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT (EXIT=0).";
00620GOSUB 9000
00630O0=O1
00640IF O1=4 THEN 970
00650IF O1=1 THEN 2790
00660IF O1=2 THEN 2330
00670IF O1=3 THEN 1980
00680IF O1=5 THEN 1630
00690IF O1=6 THEN 1310
00700IF O1=0 THEN 4770
00710IF O1=7 THEN 740
00720PRINT "REENTER. INPUT MUST BE NUMBER OF OPTION."
00730GOTO 620
00740PRINT L$
00750PRINT " IDENTITY Y=X X IS A SOURCE VARIABLE"
00760GOSUB 3790
00770PRINT
00780PRINT "INPUT THE NUMBER OF THE SOURCE VARIABLE (NONE=0).";
00790GOSUB 9000
00800IF O1=0 THEN 490
00810IF O1>V0 THEN 940
00820IF O1<1 THEN 940
00830T1=1
00840X1=O1
00850GOSUB 4005
00860FOR K5=1 TO N0
00870W(K5+W0*N0-N0)=X(K5+X1*N0-N0)
00880NEXT K5
00890L(2,W0)=L(1,X1)
00900H(2,W0)=H(1,X1)
00903IF O9=7 THEN 780
00910PRINT L$
00920PRINT "TRANSFORMATION COMPLETED."
00930GOTO 750
00940PRINT "REENTER. INPUT MUST BE NUMBER OF SOURCE VARIABLE."
00950GOTO 790
00960REM --- STANDARDIZE ---
00970PRINT L$
00980PRINT " STANDARDIZE Y=(X-X.)/SIGMA X"
00990GOSUB 3790
01000S0=0
01010M0=0
01020FOR K5=1 TO N0
01030IF T1=1 THEN 1060
01040X3=W(K5+X1*N0-N0)
01050GOTO 1070
01060X3=X(K5+X1*N0-N0)
01070S0=S0+X3*X3
01080M0=M0+X3
01090NEXT K5
01100S0=S0-M0*M0/N0
01110M0=M0/N0
01120IF S0 <= 0 THEN 1160
01130GOSUB 4000
01140S0=SQR(S0/N0)
01150GOTO 1200
01160PRINT "TRANSFORMATION NOT COMPLETED BECAUSE SIGMA X IS ZERO."
01170PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
01180GOSUB 9000
01190GOTO 970
01200FOR K5=1 TO N0
01210IF T1=1 THEN 1240
01220X3=W(K5+X1*N0-N0)
01230GOTO 1250
01240X3=X(K5+X1*N0-N0)
01250W(K5+W0*N0-N0)=(X3-M0)/S0
01260GOSUB 2640
01270NEXT K5
01280GOSUB 2720
01290GOTO 980
01300REM --- FREEMAN TUKEY ARCSINE---
01310PRINT L$
01320PRINT " FREEMAN-TUKEY ARCSINE"
01330PRINT
01340PRINT " Y=.5*(ARCSIN(SQR(X/(N+1)))+ARCSIN(SQR((X+1)/(N+1))))"
01350PRINT
01360GOSUB 3790
01370PRINT "INPUT YOUR VALUE FOR N."
01380GOSUB 9000
01390N=O1
01400IF O1>0 THEN 1430
01410PRINT "REENTER. N MUST BE GREATER THAN 0."
01420GOTO 1380
01430IF L(T1,X1)<0 THEN 1480
01440IF H(T1,X1)>N THEN 1480
01450GOSUB 4000
01460K6=X1*N0-N0
01470GOTO 1550
01480PRINT "THERE ARE OBSERVATIONS FOR WHICH THE VALUE OF X DOES NOT"
01490PRINT "SATISFY THE CONDITION THAT X BE AT LEAST ZERO AND NOT GREATER"
01500PRINT "THAN N."
01510PRINT
01520PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
01530GOSUB 9000
01540GOTO 1310
01550FOR K5=1 TO N0
01552IF T1=1 THEN 1560
01553P9=W(K5+K6)
01554GOTO 1570
01560P9=X(K5+K6)
01570GOSUB 4580
01580GOSUB 2640
01590NEXT K5
01600GOSUB 2720
01610GOTO 1320
01620REM---LOG ODDS ---
01630PRINT L$
01640PRINT " LOG-ODDS LOG((X-A)/(B-X))"
01650GOSUB 3790
01660GOSUB 3070
01670IF C1 >= L(T1,X1) THEN 1870
01680PRINT "INPUT B";
01690GOSUB 9000
01700IF O1 <= H(T1,X1) THEN 1870
01710C2=O1
01720GOSUB 4000
01730K6=X1*N0-N0
01740IF T1=1 THEN 1810
01750FOR K5=1 TO N0
01760L=W(K5+K6)
01770W(K5+W0*N0-N0)=LOG(L-C1)-LOG(C2-L)
01780GOSUB 2640
01790NEXT K5
01800GOTO 1960
01810FOR K5=1 TO N0
01820L=X(K5+K6)
01830W(K5+W0*N0-N0)=LOG(L-C1)-LOG(C2-L)
01840GOSUB 2640
01850NEXT K5
01860GOTO 1960
01870PRINT
01880PRINT "TRANSFORMATION CAN NOT BE COMPLETED BECAUSE THE VALUES"
01890PRINT "YOU INPUTTED FOR A AND B DO NOT SATISFY THE CONDITION"
01900PRINT "THAT A BE LESS THAN THE MINIMUM OF X AND B BE GREATER"
01910PRINT "THE MAXIMUM OF X."
01920PRINT
01930PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
01940GOSUB 9000
01950GOTO 1630
01960GOSUB 2720
01970GOTO 1640
01980PRINT L$
01990REM--- NATURAL LOGS --
02000PRINT " NATURAL LOGS Y=A*LOG(X+B)+C X+B>0"
02010GOSUB 3790
02020GOSUB 3070
02030PRINT "INPUT B.";
02040GOSUB 9000
02050IF O1+L(T1,X1)>0 THEN 2130
02060PRINT "TRANSFORMATION CAN NOT BE COMPLETED BECAUSE FOR THE "
02070PRINT "VALUE OF B YOU SPECIFIED THERE ARE X VALUES SUCH"
02080PRINT "THAT X+B IS LESS THAN OR EQUAL TO ZERO."
02090PRINT
02100PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
02110GOSUB 9000
02120GOTO 1980
02130C2=O1
02140PRINT "INPUT C.";
02150GOSUB 9000
02160C3=O1
02170GOSUB 4000
02180IF T1=1 THEN 2250
02190FOR K5=1 TO N0
02200L=W(K5+X1*N0-N0)+C2
02210W(K5+W0*N0-N0)=C1*LOG(L)+C3
02220GOSUB 2640
02230NEXT K5
02240GOTO 2300
02250FOR K5=1 TO N0
02260L=X(K5+X1*N0-N0)+C2
02270W(K5+W0*N0-N0)=C1*LOG(L)+C3
02280GOSUB 2640
02290NEXT K5
02300GOSUB 2720
02310GOTO 2000
02320REM -- POWER FUNCTION ---
02330PRINT L$
02340PRINT " POWER FUNCTION Y=AX**B+C 1/5<= ABSOLUTE(B) <=10"
02350GOSUB 3790
02360GOSUB 3070
02370PRINT "INPUT B.";
02380GOSUB 9000
02390IF ABS(O1) <= 10 THEN 2500
02400PRINT "REENTER. ABSOLUTE VALUE OF POWER MUST NOT BE GREATER THAN"
02410PRINT "10 OR LESS THAN 1/5."
02420GOTO 2380
02430PRINT "FOR SOME OF THE OBSERVATIONS THIS VARIABLE IS NEGATIVE. YOU"
02440PRINT "CAN NOT USE THE POWER TRANSFORMATION WITH THE POWER YOU WANT."
02450PRINT
02460PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
02470GOSUB 9000
02480PRINT L$
02490GOTO 2340
02500IF ABS(O1)<.2 THEN 2400
02510IF L(T1,X1)<0 THEN 2430
02520C2=O1
02530PRINT "INPUT C.";
02540GOSUB 9000
02550C3=O1
02560GOSUB 4000
02570FOR K5=1 TO N0
02580IF T1=1 THEN 2610
02590W(K5+W0*N0-N0)=W(K5+X1*N0-N0) ** C2*C1+C3
02600GOTO 2620
02610W(K5+W0*N0-N0)=X(K5+X1*N0-N0) ** C2*C1+C3
02620GOSUB 2640
02630GOTO 2690
02640IF W(K5+W0*N0-N0)<H0 THEN 2660
02650H0=W(K5+W0*N0-N0)
02660IF W(K5+W0*N0-N0)>L0 THEN 2680
02670L0=W(K5+W0*N0-N0)
02680RETURN
02690NEXT K5
02700GOSUB 2720
02710GOTO 2340
02720PRINT L$
02730PRINT "TRANSFORMATION COMPLETED."
02740L(2,W0)=L0
02750H(2,W0)=H0
02760PRINT
02770RETURN
02780REM- LINEAR TRAN
02790PRINT L$
02800PRINT " LINEAR FUNCTION Y=AX+BZ+C"
02810GOSUB 3790
02820GOSUB 3070
02830GOTO 3110
02840IF W0 <> 0 THEN 2860
02850T1=1
02860PRINT
02870PRINT "INPUT THE TYPE OF THE VARIABLE X."
02880GOSUB 3520
02890IF O1=0 THEN 490
02900T1=O1
02910PRINT
02920PRINT "INPUT THE NUMBER OF THE VARIABLE X.";
02930GOSUB 2970
02940X1=O1
02950RETURN
02960REM= INPUT AND CHECK VARIABLE NUMBER ==
02970IF T1=1 THEN 3000
02980Z0=W2
02990GOTO 3010
03000Z0=V0
03010GOSUB 9000
03020IF O1 <= Z0 THEN 3050
03030PRINT "REENTER. INPUT MUST BE THE NUMBER OF VARIABLE."
03040GOTO 3010
03050IF O1<1 THEN 3030
03060RETURN
03070PRINT "INPUT A.";
03080GOSUB 9000
03090C1=O1
03100RETURN
03110PRINT "INPUT THE TYPE OF VARIABLE Z. (NONE=0)";
03120GOSUB 9000
03130IF O1 <> 0 THEN 3160
03140T2=O1
03150GOTO 3280
03160GOSUB 3570
03170T2=O1
03180IF O1=0 THEN 3280
03190PRINT "INPUT THE NUMBER OF THE VARIABLE Z.";
03200IF T2=1 THEN 3230
03210GOSUB 2980
03220GOTO 3240
03230GOSUB 3000
03240X2=O1
03250PRINT "INPUT B.";
03260GOSUB 9000
03270C2=O1
03280PRINT "INPUT C.";
03290GOSUB 9000
03300C3=O1
03310GOSUB 4000
03320FOR K5=1 TO N0
03330IF T1=1 THEN 3360
03340P1=W(K5+X1*N0-N0)
03350GOTO 3370
03360P1=X(K5+X1*N0-N0)
03370IF T2=0 THEN 3430
03380IF T2=1 THEN 3410
03390P2=W(K5+X2*N0-N0)
03400GOTO 3450
03410P2=X(K5+X2*N0-N0)
03420GOTO 3450
03430P2=C1*P1+C3
03440GOTO 3460
03450P2=C1*P1+C2*P2+C3
03460W(K5+W0*N0-N0)=P2
03470GOSUB 2640
03480NEXT K5
03490GOSUB 2720
03500GOTO 2800
03510REM * INPUT VARIABLE TYPE *
03520IF W0 <> 0 THEN 3550
03530PRINT "SOURCE=1 NONE=0 ";
03540GOTO 3560
03550PRINT "SOURCE=1 WORKING=2 NONE=0 ";
03560GOSUB 9000
03570IF O1=1 THEN 3650
03580IF O1 <> 2 THEN 3620
03590IF W2 <> 0 THEN 3650
03600PRINT "REENTER. THERE ARE NO WORKING SET VARIABLES."
03610GOTO 3560
03620IF O1=0 THEN 3650
03630PRINT "REENTER. INPUT MUST BE 0,1 OR 2."
03640GOTO 3560
03650RETURN
03660PRINT
03670IF W2=0 THEN 3740
03680PRINT "WORKING SET VARIABLES: MINIMUM MAXIMUM"
03690FOR K0=1 TO W2
03700L0=L(2,K0)
03710H0=H(2,K0)
03720 PRINT USING 3890,K0,MID$(V1$,K0*6-5,K0*6-(K0*6-5)+1),L0,H0
03730NEXT K0
03740H0=-1.E+34
03750L0=1.E+35
03760IF O0=7 THEN 3780
03770GOTO 2840
03780RETURN
03790PRINT
03800PRINT "SOURCE SET VARIABLES: MINIMUM MAXIMUM"
03810T1=1
03820FOR K0=1 TO V0
03830IF B0=0 THEN 3870
03840L0=L(1,K0)
03850H0=H(1,K0)
03860GOTO 3900
03870X1=K0
03880GOSUB 4840
03890: ## = 'CCCCC #########.#### ##########.###
03900 PRINT USING 3890,K0,MID$(V$,K0*6-5,K0*6-(K0*6-5)+1),L0,H0
03910L(1,K0)=L0
03920H(1,K0)=H0
03930NEXT K0
03940B0=1
03950PRINT
03960H0=-1.E+35
03970L0=1.E+35
03980GOTO 3660
03990REM- CHECK TO SEE WHERE TO PUT NEW VARIABLE
04000PRINT L$
04005W0=0
04006IF O9=7 THEN 4170
04010IF W2 <> 0 THEN 4040
04030GOTO 4170
04040 W0=0
04042 GOTO 4170
04050PRINT "YOU HAVE THE OPTION OF PUTTING THE NEW VARIABLE IN THE NEXT"
04060PRINT "FREE COLUMN OF THE WORKING SET DATA MATRIX OR PUTTING IT IN"
04070PRINT "IN A PRESENTLY OCCUPPIED COLUMN OF THE WORKING SET MATRIX."
04080PRINT
04090PRINT "WORKING SET VARIABLES:"
04100FOR K0=1 TO W2
04110 PRINT USING 3890,K0,MID$(V1$,K0*6-5,K0*6-(K0*6-5)+1)
04120NEXT K0
04130PRINT
04140PRINT "NEXT FREE COLUMN=0 OR NUMBER OF OCCUPIED COLUMN ";
04150GOSUB 9000
04160W0=INT(O1)
04170W6=0
04180IF W0=0 THEN 4250
04190IF W0 >= 1 THEN 4220
04200PRINT "REENTER. INPUT MUST BE 0 OR NUMBER OF WORKING SET VARIABLE."
04210GOTO 4150
04220IF W0 <= W2 THEN 4350
04230PRINT "REENTER. INPUT MUST BE 0 OR NUMBER OF OCCUPPIED COLUMN."
04240GOTO 4150
04250IF W2 <= 4 THEN 4320
04260PRINT L$
04270PRINT "THERE CAN BE A MAXIMUM OF 5 VARIABLES IN THE WORKING SET."
04280PRINT "YOU ALREADY HAVE 5 AND THEREFORE CAN NOT ADD ANY MORE."
04290PRINT
04300GOTO 500
04310IF W2 <= 5 THEN 4350
04320W2=W2+1
04330W6=1
04340W0=W2
04350PRINT
04360IF O0 <> 7 THEN 4390
04370 V1$=V1$+MID$(V$,X1*6-5,6)
04380GOTO 4570
04390IF S9=1 THEN 4450
04400PRINT "YOU CAN ASSIGN THE VARIABLE A NAME OR LET THE MODULE ASSIGN"
04410 :THE NAME VAR-## .
04420 PRINT USING 4410,W0
04430PRINT
04440S9=1
04450PRINT "MODULE ASSIGNS NAME=0 YOU ASSIGN NAME=1 ";
04460GOSUB 9000
04470IF O1=1 THEN 4540
04480IF O1=0 THEN 4510
04490PRINT "REENTER. INPUT MUST BE 0 OR 1."
04500GOTO 4460
04510 REM
04522 V1$=V1$+"VAR-"+MID$(N$,W0,1)+" "
04530GOTO 4570
04540PRINT
04550PRINT "INPUT THE NAME.";
04562INPUTZ$
04563 Z$=LEFT$(Z$+" ",6)
04564 V1$=V1$+Z$
04570RETURN
04580C5=SQR(P9/(N+1))
04590GOSUB 4650
04600P8=C6
04610C5=SQR((P9+1)/(N+1))
04620GOSUB 4650
04630W(K5+W0*N0-N0)=.5*(C6+P8)
04640RETURN
04650REM ARCSIN ROUTINE
04660REM INPUT C5
04670REM OUTPUT C6
04680IF ABS(C5) >= 1.E-10 THEN 4710
04690C7=1.5708-C5
04700GOTO 4720
04710C7=ATN(SQR(1-C5*C5)/C5)+1.5708*(1-SGN(C5))
04720C6=SGN(C5)*ABS(C5)
04730IF ABS(C5)>ABS(1.5708-C7) THEN 4750
04740C6=ABS(1.5708-C7)
04750RETURN
04760REM END OF ARCSIN ROUTINE
04770PRINT L$
04780V0=W2
04800MAT X=W
04810 V1$=V1$+" "
04811 V$=LEFT$(V1$,30)
04812 SCRATCH #9
04813PRINT #9,N0
04814 PRINT #9,V0
04815 FOR I=1 TO N0*V0
04816 PRINT #9,X(I)
04817 NEXT I
04818 PRINT #9,CHR$(34);V$;CHR$(34)
04819 PRINT V$
04820 CHAIN CMOD72
04830REM- MIN MAX
04840H0=-1.E+35
04850L0=1.E+35
04860FOR K5=1 TO N0
04870IF T1=1 THEN 4900
04880X2=W(K5+X1*N0-N0)
04890GOTO 4910
04900X2=X(K5+X1*N0-N0)
04910IF X2<H0 THEN 4930
04920H0=X2
04930IF X2>L0 THEN 4950
04940L0=X2
04950NEXT K5
04960RETURN
09000REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
09010INPUT O1
09020IF O1=-9999 THEN 9040
09030RETURN
09040CHAIN "RSTRT"
09050REM*************END ROUTINE
09999END