1 ! *************** WESPT1 ********************* ! ** OVERLAY #1 OF WESPUT ** 5 ! ** FROM LOUISVILLE EXP SIMULATION SYSTEM ** 6 ! ** TRANSLATED 20-DEC-74 WABASH COLLEGE ** ! ** BY JAMES A. WARDEN ** ! ********************************************** 9 CHAIN"WESPUT" 10 ! WESPUT CHAINS HERE... 20 O$=SYS(CHR$(7%)) : O%=INSTR(1%,O$,"!") : IF O%=0% THEN 30 24 O1$=MID(O$,O%+1%,4%) : O$=LEFT(O$,O%-1%) : S$=SYS(CHR$(8%)+O$) 30 OPEN O$ AS FILE 1% 40 DIM #1%,X%(48),A9(1),A1$(5)=128,A2$(24,4)=128,D2(24,12),X2(24,384) 50 ! \-----ID RECORD ------/ \-----24 MODEL RECORDS-----------/ 60 OPEN"WESPUT.TMP" AS FILE 2% 70 DIM #2%,A3$(9)=128,Q(3,128),X(384),D(1,12),V(24),R(10), S(10),T(10),U(10),W(27),Y(10),Z(10),N(10),K(1),L(1) 75 K=K(1) : L=L(1) 110 DEF FNC(V1)=INT(V1/Q9) 120 DEF FND(V2)=V2-FNC(V2)*Q9 130 Q9=128 : Q8=3 ! Q MATRIX DIM; SIZE OF X = PRODUCT 210 E0=A9(1) : A$=A1$(1) : B$=A1$(2) : H$=A1$(3) 215 FOR U%=1% TO E0 : IF X%(U%)=-1% THEN E0=U% : GO TO 220 217 NEXT U% 220 J$=A3$(1) 300 IF O1$="3870" THEN O1$="" : GO TO 3870 2850 IF N(3)=0 THEN 3290 2860 PRINT "GIVE THE NUMBER OF CATEGORIES IN EACH OF THE";N(3); 2870 PRINT "CONTINUOUS VARIABLES" 2880 PRINT" NOTE: NEGATIVE VALUE INDICATES VARIABLE WILL NOT "; "BE DESCRETIZED." 2900 INPUT X(U%) FOR U%=1% TO N(3) 2910 D(1,1)=L : D(1,2)=K 2930 FOR I=1 TO N(3) 2940 GOSUB 4600 2950 Q(L,K)=X(I) 2955 IF X(I)>0. THEN W(I+N(1)+N(2))=X(I) 2960 NEXT I 2970 D(1,3)=L+FNC(K) 2980 D(1,4)=FND(K) 2990 L1=D(1,1) : K1=D(1,2) 3010 FOR I=1 TO N(3) 3020 GOSUB 4650 3030 IF Q(L1,K1)<0 THEN 3110 3040 PRINT "GIVE THE UPPER BOUND OF THE";Q(L1,K1);"CATEGORIES OF"; 3050 PRINT " VARIABLE #";I+N(1)+N(2) 3060 INPUT X(U%) FOR U%=1% TO Q(L1,K1) 3070 FOR J=1 TO Q(L1,K1) 3080 GOSUB 4600 3090 Q(L,K)=X(J) 3100 NEXT J 3110 NEXT I 3120 D(1,5)=L : D(1,6)=K : L1=D(1,1) : K1=D(1,2) 3160 FOR I=1 TO N(3) 3170 GOSUB 4650 : IF Q(L1,K1)<0 THEN 3270 ! SKIP NON-DES VAR 3190 PRINT "NOW GIVE THE";ABS(Q(L1,K1));"VALUES OF THE CUMULATIVE"; 3200 PRINT " PROBABILITIES OF THE CONTINUOUS VARIABLE #";I+N(1)+N(2) 3210 INPUT X(U%) FOR U%=1% TO ABS(Q(L1,K1)) 3220 FOR J=1 TO ABS(Q(L1,K1)) 3230 GOSUB 4600 : Q(L,K)=X(J) 3250 NEXT J 3270 NEXT I 3280 GOTO 3320 3290 GOSUB 4600 3300 D(1,5)=L 3310 D(1,6)=K 3320 IF N(4)=0 THEN 3560 3330 FOR I=1 TO N(4) 3340 GOSUB 4600 3350 Q(L,K)=P(I) 3360 NEXT I 3370 P5=N(4) 3380 FOR I=1 TO N(4) 3390 P4=Q(1,9+M+2*P(I))-Q(1,8+M+2*P(I))+1 3400 GOSUB 4600 3410 Q(L,K)=P4 3420 PRINT "GIVE THE";P4;"TERMS OF THE CUMULATIVE PROBABILITY"; 3430 PRINT "FUNCTION WHICH WILL BE USED TO RANDOMIZE VARIABLE";P(I) 3440 INPUT X(U%) FOR U%=1% TO P4 3450 FOR J=1 TO P4 3460 GOSUB 4600 3470 Q(L,K)=X(J) 3480 NEXT J 3490 P5=P5+P4+1 3500 NEXT I 3510 L1=D(1,5) 3520 K1=D(1,6) 3530 GOSUB 4660 3540 D(1,5)=L1 3550 D(1,6)=K1 3560 IF N(10)=999 THEN 4700 !(NOT WRITING OWN MODEL) 3570 PRINT "HOW MANY VALUES WILL THERE BE IN THE COST VECTOR"; 3580 INPUT M1 3590 PRINT "GREAT! NOW HOW MANY IN THE EFFECTS VECTOR? (#COSTS +" 3600 PRINT "# EFFECTS <=";Q9*Q8-Q9*L-K-2;")"; 3610 INPUT M2 3620 IF INT((M1+M2+K+2)/Q9)+L+1<=Q8 THEN 3660 3630 PRINT "TOO BIG FOR Q - TRY AGAIN, OR RE-DIMENSION Q HERE AND IN" 3640 PRINT "COMMON OF ALL MODELS AND MAIN PROGRAM." 3650 GO TO 3560 3660 GOSUB 4600 3670 LET D(1,7)=L+FNC(K+1) 3680 LET D(1,8)=FND(K+1) 3690 Q(L,K)=M1 3700 GOSUB 4600 3710 Q(L,K)=M2 3720 IF M1=0 THEN 3790 3730 PRINT "NOW GIVE THE";M1;"VALUES OF COSTS"; 3740 INPUT X(U%) FOR U%=1% TO M1 3750 FOR I=1 TO M1 3760 GOSUB 4600 3770 LET Q(L,K)=X(I) 3780 NEXT I 3790 LET D(1,9)=FNC(K)+L 3800 LET D(1,10)=FND(K) 3810 PRINT "NOW GIVE THE";M2;"VALUES OF EFFECTS (ONE/LINE)" 3820 INPUT X(I) FOR I=1 TO M2 3830 FOR I=1 TO M2 3840 GOSUB 4600 3850 LET Q(L,K)=X(I) 3860 NEXT I 3870 D(1,11)=L : D(1,12)=K 3890 INPUT"DO YOU WANT TO SEE Q(Y/N)";E$ : IF ASCII(E$)=78% THEN 4070 3920 PRINT "D VECTOR" 3930 MAT PRINT D; 3940 PRINT "Q MATRIX" 3950 FOR I=1 TO D(1,11) 3960 LET X1=Q9 3970 IF I"N" THEN 4070 4055 E$=SYS(CHR$(7%)) : E$=SYS(CHR$(8%)+E$+"!2220") 4057 PRINT"** WAIT A MOMENT PLEASE **" 4060 CLOSE 1%,2% : CHAIN "WESPUT" 20 4070 D2(E0,I%)=D(1,I%) FOR I%=1% TO 12% ! D VECTOR -> MODEL 4080 MAT X=ZER : J5=0 4090 FOR I=1 TO D(1,11) 4100 LET X1=Q9 4110 IF I MODEL 4200 E1=A9(1) : C$=A1$(1) : F$=A1$(2) : H$=A1$(3) : A$=A1$(4) : B$=A1$(5) 4205 FOR U%=1% TO E1 : IF X%(U%)=-1% THEN E1=U% : GO TO 4210 4207 NEXT U% 4210 INPUT"GIVE UP TO 6 CHARACTERS FOR MODEL NAME";E$ : E$=LEFT(E$+SPACE$(6%),6%) 4260 LET K=1 4270 IF E1>12 THEN 4300 4280 IF E1<>A9(1) THEN C$=LEFT(C$,6*E1-6)+E$+RIGHT(C$,6*E1+1) ELSE C$=C$+E$ 4290 GO TO 4320 4300 IF E1<>A9(1) THEN F$=LEFT(F$,6*E1-78)+E$+RIGHT(F$,6*E1-65) ELSE F$=F$+E$ 4320 ! DETERMINE NEXT PROGRAM NAME. 4330 LET I$="2242322212019181716151413121110" 4340 LET D$="9876543210" 4350 LET E$=J$ 4355 IF N(10) < 9000 THEN 4490 ! USING OWN PROGRAM 4360 IF MID(E$,6,1)=" " THEN 4430 4370 FOR I=1 TO 30 STEP 2 4380 IF MID(H$,5,2)<>MID(I$,I,2) THEN 4410 4390 H$=LEFT(H$,4%)+MID(I$,I-2,2)+RIGHT(H$,7%) 4400 GO TO 4490 4410 NEXT I 4420 PRINT "ERROR" : GO TO 9000 4430 FOR I=2 TO 10 4440 IF MID(H$,5,1)<>MID(D$,I,1) THEN 4470 4450 H$=LEFT(H$,4%)+MID(D$,I-1,1)+RIGHT(H$,6%) 4460 GO TO 4490 4470 NEXT I 4480 H$=LEFT(H$,4%)+"10"+RIGHT(H$,7%) 4490 IF E1>12 THEN 4520 4500 A$=LEFT(A$,6*E1-6)+E$+RIGHT(A$,6*E1+1) 4510 GO TO 4530 4520 B$=LEFT(B$,6*E1-78)+E$+RIGHT(B$,6*E1-65) 4530 X%(E1)=D(1,12) 4550 IF E1=A9(1) THEN A9(1)=E1+1 4560 A1$(1)=C$ : A1$(2)=F$ : A1$(3)=H$ : A1$(4)=A$ : A1$(5)=B$ 4570 KILL"WESPUT.TMP" : GO TO 9010 4595 ! ========== INDEX SUBROUTINE =========== 4600 K=K+1 : IF K>Q9 THEN L=L+1 : K=1 4640 RETURN 4650 K1=K1+1 : IF K1>Q9 THEN L1=L1+1 : K1=1 4690 RETURN 4700 K(1)=K : L(1)=L : CLOSE 1%,2% 4710 PRINT : PRINT"." : CHAIN "WESPT2" 10 9000 K(1)=K : L(1)=L 9010 CLOSE 1%,2% 9999 END