mirror of
https://github.com/PDP-10/stacken.git
synced 2026-03-01 17:26:38 +00:00
295 lines
7.4 KiB
QBasic
295 lines
7.4 KiB
QBasic
|
|
|
|
|
|
100 REM MARKET - SIMULATION OF MARKET COMPETITION BETWEEN 2 COMPANIES
|
|
105 REM DEVELOPED BY S. FINKELSTEIN, J. MCGRATH, I. STAW, D. SOBIN
|
|
110 REM ALSO DEVELOPED BY D. KLASSEN - PROGRAMMED BY D. SOBIN
|
|
115 REM LATEST REVISION 8-29-72
|
|
120 REM COPYRIGHT 1972 - STATE UNIVERSITY OF NEW YORK
|
|
125 DEFFNR(X)=.01*INT(100*X+.5)
|
|
130 DIMC(2),I(2),T(2),A(2),L(2),D(2),P(2),V(2),W(2),B(2),E(5),F(2)
|
|
135 PRINT"DO YOU WANT INSTRUCTIONS(TYPE 1 FOR YES, 0 FOR NO)";
|
|
140 INPUTH
|
|
145 READ K2,N,K,K3,C(1),C(2),I(1),I(2),F,U,R,G1,G2,G3,M1,K4,W2,W3,W4
|
|
150 LETQ=0
|
|
155 PRINT
|
|
160 IFH=0THEN200
|
|
165 PRINT"MARKET SIMULATES THE COMPETITION BETWEEN TWO COMPANIES"
|
|
170 PRINT"SELLING A PRODUCT DIFFERENTIATED BY BRAND ADVERTISING."
|
|
175 PRINT"THE QUANTITY EACH COMPANY SELLS IS DEPENDENT UPON PRICE"
|
|
180 PRINT"AND ADVERTISING BUDGET. THE GAME ENDS WHEN ONE "
|
|
185 PRINT"COMPANY GOES BANKRUPT OR REACHES ";.001*M1;" MILLION IN"
|
|
190 PRINT"TOTAL ASSETS."
|
|
195 PRINT
|
|
200 PRINT"ARE YOU BEGINNING THE GAME OR CONTINUING"
|
|
205 PRINT"(TYPE 1 FOR BEGINNING, 2 FOR CONTINUING)";
|
|
210 INPUTA
|
|
215 PRINT
|
|
220 IFA=1THEN270
|
|
225 FORJ=1TO2
|
|
230 PRINT"COMPANY ";J;"ENTER PREVIOUS CASH ON HAND,PREVIOUS INVENTORY"
|
|
235 INPUTC(J),I(J)
|
|
240 PRINT
|
|
245 NEXTJ
|
|
250 PRINT"ENTER VARIABLE PRODUCTION COST";
|
|
255 INPUTU
|
|
260 PRINT"ENTER QUARTER NUMBER";
|
|
265 INPUTQ
|
|
270 PRINT
|
|
275 PRINT"FIXED PRODUCTION COST=";F*1E3;" DOLLARS/QUARTER"
|
|
280 PRINT"VARIABLE PRODUCTION COST=";U;" DOLLARS/UNIT"
|
|
285 PRINT"WITH NO ADVERTISING AND A SELLING PRICE OF 50 DOLLARS/UNIT"
|
|
290 PRINT"A COMPANY WILL SELL ";K2*500;" UNITS (PRINTED AS ";K2/2;")"
|
|
295 PRINT"WAREHOUSE CHARGE FOR INVENTORY=";R*100;" PER CENT"
|
|
300 PRINT"INTEREST CHARGE ON BORROWED MONEY=";K3*100;" PER CENT"
|
|
305 PRINT
|
|
310 PRINT
|
|
315 RANDOMIZE
|
|
320 PRINT
|
|
325 PRINT
|
|
330 PRINT"UNITS AND DOLLARS BELOW ARE IN THOUSANDS "
|
|
335 PRINT
|
|
340 PRINT
|
|
345 FORJ=1TO5
|
|
350 LETE(J)=0
|
|
355 NEXTJ
|
|
360 LETP4=0
|
|
365 GOSUB875
|
|
370 FORJ=1TO2
|
|
375 LETW(J)=0
|
|
380 LETD(J)=0
|
|
385 LETT(J)=0
|
|
390 LETB(J)=U*I(J)+C(J)
|
|
395 GOSUB900
|
|
400 NEXTJ
|
|
405 PRINT
|
|
410 LETQ=Q+1
|
|
415 GOSUB1060
|
|
420 GOSUB675
|
|
425 GOSUB865
|
|
430 REM COMPUTE DEMAND
|
|
435 FORJ=1TO2
|
|
440 LETD(J)=(1-E(5))*.5*(K2+2*V(J)*D1)/(P(J)/50)^N
|
|
445 NEXTJ
|
|
450 GOSUB1000
|
|
455 FORJ=1TO2
|
|
460 IFD(J)>I(J)THEN475
|
|
465 LETT(J)=D(J)
|
|
470 GOTO480
|
|
475 LETT(J)=I(J)
|
|
480 LETT(J)=INT(T(J))
|
|
485 LETC(J)=C(J)+T(J)*P(J)
|
|
490 LETI(J)=I(J)-T(J)
|
|
495 NEXTJ
|
|
500 FORJ=1TO2
|
|
505 LETC(J)=C(J)-R*I(J)*U-K3*C(J)*(SGN(C(J))-SGN(C(J))^2)/2
|
|
510 LETC(J)=INT(C(J))
|
|
515 IFE(5)=0THEN530
|
|
520 LETW(J)=0
|
|
525 GOTO540
|
|
530 IFT(1)+T(2)=0THEN520
|
|
535 LETW(J)=INT(10000*T(J)/(T(1)+T(2)))/100
|
|
540 NEXTJ
|
|
545 FORJ=1TO2
|
|
550 GOSUB900
|
|
555 LETB(J)=C(J)+U*I(J)
|
|
560 IFB(J)>0THEN580
|
|
565 PRINT
|
|
570 GOSUB975
|
|
575 PRINT
|
|
580 IFB(J)<M1THEN620
|
|
585 IFB(J)<=C(3-J)+U*I(3-J)THEN620
|
|
590 LETP4=17
|
|
595 PRINT
|
|
600 PRINTTAB(14);"********************"
|
|
605 PRINT"COMPANY ";J;" YOU HAVE REACHED ";M1/1E3;" MILLION AND WON"
|
|
610 PRINTTAB(14);"********************"
|
|
615 PRINT
|
|
620 NEXTJ
|
|
625 PRINT
|
|
630 IFP4<>17THEN410
|
|
635 PRINT
|
|
640 PRINT"DO YOU WANT TO PLAY AGAIN(TYPE 1 FOR YES, 0 FOR NO)";
|
|
645 INPUTH
|
|
650 IFH=0THEN670
|
|
655 RESTORE
|
|
660 PRINT
|
|
665 GOTO135
|
|
670 STOP
|
|
675 PRINT
|
|
680 FORJ=1TO2
|
|
685 PRINT
|
|
690 PRINT
|
|
695 PRINT"COMPANY ";J
|
|
700 IFE(2)<>1THEN715
|
|
705 PRINT"NO PRODUCTION POSSIBLE DUE TO STRIKE"
|
|
707 LETL(J)=0
|
|
710 GOTO730
|
|
715 PRINT"PRODUCTION LEVEL";
|
|
720 INPUTL(J)
|
|
725 IFL(J)<0THEN715
|
|
730 PRINT"ADVERTISING BUDGET";
|
|
735 INPUTA(J)
|
|
740 IFA(J)<0THEN730
|
|
745 LETC(J)=C(J)-F-L(J)*U-A(J)
|
|
750 IFE(2)=1THEN760
|
|
755 LETI(J)=I(J)+L(J)
|
|
760 PRINT"UNIT PRICE";
|
|
765 INPUTP(J)
|
|
770 IFABS(P(J)-100)>=100THEN760
|
|
775 IFE(1)<>1THEN815
|
|
776 IFP(J)<=F(J)THEN815
|
|
780 PRINT
|
|
785 PRINT"YOU MAY NOT RAISE PRICES DURING THE WAGE-PRICE FREEZE"
|
|
790 PRINT
|
|
795 GOTO760
|
|
815 NEXTJ
|
|
820 LETA2=A(1)+A(2)
|
|
825 IFA2>0THEN845
|
|
830 LETV(1)=0
|
|
835 LETV(2)=0
|
|
840 GOTO855
|
|
845 LETV(1)=A(1)/A2
|
|
850 LETV(2)=A(2)/A2
|
|
855 LETD1=(K2-K2*EXP(-K*A2))*K4
|
|
860 RETURN
|
|
865 PRINT
|
|
870 PRINT
|
|
875 PRINT"QUARTER ";Q
|
|
880 PRINT
|
|
885 PRINT"PROFIT MARKET SHARE CASH ON HAND NUMBER SOLD ";
|
|
890 PRINT"INVENT. ASSETS"
|
|
895 RETURN
|
|
900 PRINTU*I(J)+C(J)-B(J);TAB(9);W(J);TAB(23);C(J);TAB(37);
|
|
905 PRINTT(J);TAB(50);I(J);TAB(58);U*I(J)+C(J)
|
|
910 RETURN
|
|
915 DATA50
|
|
920 DATA2
|
|
925 DATA.001
|
|
930 DATA.05
|
|
935 DATA5000,5000
|
|
940 DATA100,100
|
|
945 DATA250
|
|
950 DATA20
|
|
955 DATA.05
|
|
960 DATA.2,.4,.4
|
|
965 DATA12000
|
|
970 DATA1.5
|
|
972 DATA0,0,0
|
|
975 PRINTTAB(7);"********************"
|
|
980 PRINT"COMPANY ";J;" YOU HAVE GONE BANKRUPT"
|
|
985 PRINTTAB(7);"********************"
|
|
990 LETP4=17
|
|
995 RETURN
|
|
1000 IFP(1)<P(2)THEN1015
|
|
1005 LETM=2
|
|
1010 GOTO1020
|
|
1015 LETM=1
|
|
1020 LETG4=(P(3-M)-P(M))/P(3-M)
|
|
1025 IFG4<=G1THEN1055
|
|
1030 IFG4<G2THEN1040
|
|
1035 LETG4=G2
|
|
1040 LETG5=D(3-M)*((G4-G1)/(G2-G1))*G3
|
|
1045 LETD(3-M)=D(3-M)-G5
|
|
1050 LETD(M)=D(M)+G5
|
|
1055 RETURN
|
|
1060 IFQ<6THEN1230
|
|
1065 IFRND(1)<.1THEN1090
|
|
1070 IFRND(1)<.1THEN1115
|
|
1075 IFRND(1)<.1THEN1165
|
|
1080 IFRND(1)<.1THEN1200
|
|
1085 GOTO1230
|
|
1090 IFE(1)>0THEN1070
|
|
1091 LETF(1)=P(1)
|
|
1092 LETF(2)=P(2)
|
|
1095 GOSUB1300
|
|
1100 LETE(1)=1
|
|
1105 LETQ1=Q
|
|
1110 GOTO1070
|
|
1115 LETI=INT(RND(1)+1.5)
|
|
1120 IFQ-W2<=2THEN1075
|
|
1125 IFC(I)<0THEN1075
|
|
1130 IFC(I)>200THEN1145
|
|
1135 LETC(I)=.75*C(I)
|
|
1140 GOTO1150
|
|
1145 LETC(I)=C(I)-200
|
|
1150 GOSUB1325
|
|
1155 LETW2=Q
|
|
1160 GOTO1075
|
|
1165 LETJ=INT(RND(1)+1.5)
|
|
1170 IFQ-W3<=2THEN1080
|
|
1175 GOSUB1350
|
|
1180 LETC(J)=C(J)+U*I(J)*.75
|
|
1185 LETI(J)=0
|
|
1190 LETW3=Q
|
|
1195 GOTO1080
|
|
1200 IFE(1)=1THEN1230
|
|
1201 IFE(2)=1THEN1230
|
|
1205 IFQ-W4<=2THEN1230
|
|
1210 LETW4=Q
|
|
1215 GOSUB1375
|
|
1220 LETE(5)=1
|
|
1225 LETQ2=Q
|
|
1230 IFINT((Q-1)/4)*4<>Q-1THEN1425
|
|
1235 IFQ=1THEN1425
|
|
1240 IFE(1)=1THEN1425
|
|
1241 IFE(2)=1THEN1425
|
|
1242 IFE(5)=1THEN1425
|
|
1245 IFRND(1)>.25THEN1280
|
|
1250 IFQ<6THEN1280
|
|
1255 GOSUB1400
|
|
1260 LETE(2)=1
|
|
1265 LETU=INT(U*(1.1+.1*RND(1)))
|
|
1270 LETQ3=Q
|
|
1275 GOTO1425
|
|
1280 LETU=INT(U*(1.05+.1*RND(1)))
|
|
1285 PRINT"NEW LABOR CONTRACT - VARIABLE PRODUCTION COST NOW=";
|
|
1290 PRINTU;" DOLLARS/UNIT"
|
|
1295 GOTO1425
|
|
1300 PRINT"THE PRESIDENT HAS JUST IMPOSED A WAGE-PRICE FREEZE ON THE"
|
|
1305 PRINT"ECONOMY, AND YOU MAY NOT RAISE THE PRICE OF YOUR PRODUCT"
|
|
1310 PRINT"OVER THE NEXT 2 QUARTERS."
|
|
1315 PRINT
|
|
1320 RETURN
|
|
1325 PRINT"COMPANY ";I;"HAS BEEN THE VICTIM OF EMBEZZLEMENT BY THE"
|
|
1330 PRINT"VICE PRESIDENT OF THE COMPANY. YOUR CASH ON HAND IS NOW ";
|
|
1335 PRINTC(I);" DOLLARS"
|
|
1340 PRINT
|
|
1345 RETURN
|
|
1350 PRINT"COMPANY";J;" HAS SUFFERED FIRE DAMAGE IN ITS WAREHOUSE"
|
|
1355 PRINT"ALL UNITS WERE DESTROYED. YOUR INSURANCE WILL REIMBURSE YOU"
|
|
1360 PRINT"IN THE AMOUNT OF";INT(U*I(J)*.75);" DOLLARS FOR THESE UNITS"
|
|
1365 PRINT
|
|
1370 RETURN
|
|
1375 PRINT"A TRANSPORTATION STRIKE HAS OCCURED, AND YOU ARE UNABLE TO"
|
|
1380 PRINT"MOVE YOUR GOODS TO THE DISTRIBUTORS. NEGOTIATIONS HAVE"
|
|
1385 PRINT"BEGUN, BUT HOPE OF A SETTLEMENT LOOKS DIM."
|
|
1390 PRINT
|
|
1395 RETURN
|
|
1400 PRINT"THERE HAS BEEN A STRIKE AND YOUR PRODUCTION HAS BEEN"
|
|
1405 PRINT"HALTED. NEGOTIATIONS HAVE BEEN STARTED, BUT HOPE OF"
|
|
1410 PRINT"A SETTLEMENT LOOKS DIM."
|
|
1415 PRINT
|
|
1420 RETURN
|
|
1425 IFE(1)<>1THEN1450
|
|
1430 IFQ<Q1+2THEN1450
|
|
1435 LETE(1)=2
|
|
1440 PRINT"THE WAGE-PRICE FREEZE HAS ENDED"
|
|
1445 PRINT
|
|
1450 IFE(5)<>1THEN1475
|
|
1455 IFQ2=QTHEN1475
|
|
1460 LETE(5)=0
|
|
1465 PRINT"TRANSPORTATION STRIKE SETTLED. NORMAL DELIVERIES RESUMED"
|
|
1470 PRINT
|
|
1475 IFE(2)<>1THEN1505
|
|
1480 IFQ3=QTHEN1505
|
|
1485 PRINT"STRIKE SETTLED. NORMAL PRODUCTION RESUMED"
|
|
1490 PRINT"NEW VARIABLE COST=";U;" DOLLARS/UNIT DUE TO INCREASED WAGES"
|
|
1495 PRINT
|
|
1500 LETE(2)=0
|
|
1505 RETURN
|
|
1510 END
|
|
|
|
|
|
|
|
*U*0*53 |