Listing of file='FCST128A' on disk='vmedia/701-2663.wvd.zip'
# Sector 42, program filename = 'FCST128A'
0010 REM FCST128A, RELEASE 1-0, (07/24/79), THIS PROGRAM IS A COPYRIGHT PRODU
CT OF WANG LABORATORIES., UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED,
DEMAND SIMULATOR EXECUTION
4000 DIM Q6$80
: DIM A$(60)1,B2(13),B3(13),D(60),D$(60)1,D0(44),D0$(44)1,I$1,I5(5),I6(5),I
7(5),I8(5),K$(44)1,K1$(60)2,K3(1),K6(10,2),K8(5),K9(5),O$(13)1,O6$1,O8$8,
O9$8
: DIM A$1,A0$1,A2$1,A4$1,A6$1,B$1,B1$1
: DIM D6$4,D6$(3)7,D7$6,D7$(39)12
4020 DIM C6$4,C6$(21)2,C7$(21)1,P7$(1)2,Q9
4040 %########.#
4045 %######## ########.#
4050 %-####.# %
4055 GOTO 5095
4060 DEFFNP(W)=ROUND((100*W,0)
4065 DEFFNF(W)=ROUND((W,1)
4070 DEFFNR(W)=FNS(INT(W*M9+.5))
4075 DEFFNS(Z)=Z+SGN(1-SGN(Z))
4100 M6=M7
: IF O6$="S"THEN 4115
: M6=M8
4115 CONVERT M6TO Q6$,(#.############^^^^)
: CONVERT STR(Q6$,1,14)TO M9
: CONVERT STR(Q6$,17,2)TO I8
: I7=0
4135 I7=I7+1
: IF M9>K6(I7,1)THEN 4135
: M6=K6(I7,1)*10^I8
: M9=G8/M6
: I8=G8/K6(I7,2)
: C=C6
: INIT(" ")D$(),D0$(),K$()
: IF O6$="D"THEN 4250
: FOR I=1TO K5
: PACK(##)D$(I)FROMFNR(D(I))
: IF I>K3THEN 4220
: PACK(##)K$(I)FROMFNR(K(I))
: IF I>K3-K4THEN 4220
: PACK(##)D0$(I)FROMFNR(D0(I)*B3(C))
4220 C=C+1
: IF C<=PTHEN 4235
: C=1
4235 NEXT I
: GOTO 4310
4250 FOR I=1TO K5
: PACK(##)D$(I)FROMFNR(D(I)*B2(C))
: IF I>K3THEN 4280
: PACK(##)K$(I)FROMFNR(K(I)*B2(C))
: IF I>K3-K4THEN 4280
: PACK(##)D0$(I)FROMFNR(D0(I))
4280 C=C+1
: IF C<=PTHEN 4295
: C=1
4295 NEXT I
4310 GOSUB 4995
: GOSUB 5010
: G7=11
: Q6$="SEASONAL"
: IF O6$="S"THEN 4340
: Q6$="DESEASONALIZED"
4340 PRINT HEX(0A0A);TAB(G7);Q6$;" DATA PLOT"
: PRINT HEX(0A)
: GOSUB 4860
: FOR I=G8TO 1STEP -1
: GOSUB '32
: INIT(" ")A$()
: PACK(##)I$FROMI
: MAT SEARCHD$()<1,K5>,=I$TO K1$()
: J=1
4400 IF K1$(J)=HEX(0000)THEN 4425
: A$(VAL(STR(K1$(J),2)))="+"
: J=J+1
: GOTO 4400
4425 IF K3=0THEN 4545
: MAT SEARCHK$()<1,K3>,=I$TO K1$()
: J=1
4440 IF K1$(J)=HEX(0000)THEN 4485
: K=VAL(STR(K1$(J),2))
: O$(2)="*"
: IF A$(K)=" "THEN 4465
: O$(2),O6$="#"
4465 A$(K)=O$(2)
: J=J+1
: GOTO 4440
4485 IF K3-K4=0THEN 4545
: MAT SEARCHD0$()<1,K3-K4>,=I$TO K1$()
: J=1
4500 IF K1$(J)=HEX(0000)THEN 4545
: K=VAL(STR(K1$(J),2))
: O$(3)="-"
: IF A$(K)=" "THEN 4525
: O$(3),O6$="#"
4525 A$(K)=O$(3)
: J=J+1
: GOTO 4500
4545 O$(1)="!"
: IF I/I8<>INT(I/I8)THEN 4565
: PRINTUSING 4040,M6*I/G8;
: O$(1)="+"
4565 PRINT TAB(G7);O$(1);A$(1);
: IF K5=1THEN 4590
: FOR J=2TO K5
: PRINT " ";A$(J);
: NEXT J
4590 PRINT O$(1)
: NEXT I
: GOSUB 4860
: MAT REDIM O$(1)13
: O$(1)="1234567891111"
: MAT REDIM O$(13)1
: GOSUB 4805
: MAT REDIM O$(1)13
: O$(1)=" "
: STR(O$(1),10,4)="0123"
: MAT REDIM O$(13)1
: GOSUB 4805
: I8=K5
: IF I8<K3(1)-2THEN 4685
: I8=K3(1)-2
4685 CONVERT STR(K1$,LEN(K1$)-1,2)TO H8
: H8=H8+1900
: I=1
: IF C6=1THEN 4715
: I=P-C6+2
: H8=H8+1
4715 PRINT TAB(G7-2+I*2);H8;
: H8=H8+1
: I=I+P
: IF I<=I8THEN 4715
: PRINT
: PRINT HEX(0A);"LEGEND:","+ = CURRENT PERIOD FORECAST";TAB(50);"SCALE ";C0
$
: IF K3>0THEN 4760
: RETURN
4760 PRINT ,"* = CURRENT PERIOD SALES"
: IF K3-K4=0THEN 4775
: PRINT ,"- = SAFETY FACTOR"
4775 IF O6$="#"THEN 4785
: RETURN
4785 PRINT ,"# = MORE THAN ONE DATA POINT"
: RETURN
4805 C=C6
: PRINT TAB(G7+1);
: FOR I=1TO K5
: PRINT O$(C);" ";
: C=C+1
: IF C<=PTHEN 4840
: C=1
4840 NEXT I
: PRINT
: RETURN
4860 O$(1),O$(3)="+"
: IF K3=0THEN 4875
: O$(3)=">"
4875 K=K3-K4+.5
: PRINT TAB(G7);"-";
: FOR I=1TO K5
: PRINT O$(2+SGN(I-K));"-";
: NEXT I
: PRINT
: RETURN
4915 PRINT TAB(M6);" --- ----";
: Q6$="-------- ----------"
: IF M9=1THEN 4935
: Q6$=STR(Q6$,9,12)
4935 FOR I=0TO K6-1
: PRINT TAB(I*G7+12);Q6$;
: NEXT I
: PRINT
: RETURN
4970 DEFFN'35(Q6$)
: SELECT PRINT 005(64)
: PRINT AT(1,0,);HEX(0A0A0A0A0A);TAB(40-LEN(Q6$)/2);Q6$
: RETURN
4995 SELECT PRINT <I0$>(133)
: RETURN
5010 Q6$="DEMAND SIMULATION/PROJECTION"
: IF K3>K4THEN 5025
: Q6$="DEMAND PROJECTION"
5025 PRINT HEX(0D0C);Q6$;TAB(66-LEN(K5$)/2);K5$
: RETURN
5040 DEFFN'36(O9$)
: INIT(O9$)O8$
: O9$=HEX(8040201008040201)
: AND (O9$,O8$)
: Q6$=HEX(3180314031203110310831043102310130002020)
: $TRAN(O9$,Q6$)R
: RETURN
5095 SELECT LIST 005(64),CO 005(64),P
: GOSUB 4995
: GOSUB '35(" ")
: P2=12
: $UNPACK(F=HEX(610461046104510451045303500260046004A001A001))A6$()TO D,D0,
G2,G1,G,D1,C0,B0,B1,A1$,A0$
: G6=D
: K4,M7,M8=0
: K5=K3+K9
: K3(1)=60
: G8=40
: MAT D=ZER
: MAT D0=ZER
: MAT I5=ZER
: MAT I6=ZER
: MAT I7=ZER
: MAT I8=ZER
: MAT K8=ZER
: MAT K9=ZER
5190 DATA 1,10,1.6,8,2,8,2.5,10,3.2,8,4,8,5,10,6.4,8,8,8,10,10
: MAT READ K6
: H8=1
: FOR I=1TO P
: IF B(I)=0THEN 5225
: B2(I)=1/B(I)
5225 B3(I)=SQR(B(I))
: NEXT I
: CONVERT STR(K9$,1,2)TO C6
: C=C6
: IF K3=0THEN 5395
: CONVERT STR(K1$,1,2)TO C6
: C=C6
: IF K9=0THEN 5315
: CONVERT STR(K1$,LEN(K1$)-1,2)TO K
: K6=(K-1)*P+C
: CONVERT STR(K9$,3,2)TO K
: CONVERT STR(K9$,1,2)TO Q9
: K4=K3+K6-(K-1)*P-Q9
: K5=K5-K4
: IF K4=K3THEN 5395
5315 FOR I=1TO K3-K4
: D(I)=B(C)*D
: D0(I)=D0
: C4=K(I)
: GOSUB '192
: IF C<>P2THEN 5355
: I6(H8)=D
: H8=H8+1
5355 C=C+1
: IF C<=PTHEN 5370
: C=1
5370 NEXT I
: D6=D
: IF K9=0THEN 5505
5395 B0,B1=0
: H9=D0
: D0=0
: GOSUB '172
: GOSUB '173
: D0=H9
: K=1
: H9=H8-1
: FOR I=K3-K4+1TO K5
: $UNPACK(F=D7$)D7$(K)TO D(I)
: K=K+1
: IF C<>P2THEN 5475
: $UNPACK(F=D6$)D6$(H8-H9)TO I6(H8)
: H8=H8+1
5475 C=C+1
: IF C<=PTHEN 5490
: C=1
5490 NEXT I
5505 IF C=1THEN 5515
: I6(H8)=D6
5515 I5,I7,I8,H9=0
: H8=1
: F8=G6
: C=C6
: FOR I=1TO K5
: I5=I5+D(I)
: IF D(I)<M7THEN 5560
: M7=D(I)
5560 IF D(I)*B2(C)<M8THEN 5575
: M8=D(I)*B2(C)
5575 IF I>K3THEN 5700
: IF I>K3-K4THEN 5615
: IF D0(I)*B3(C)<M7THEN 5600
: M7=D0(I)*B3(C)
5600 IF D0(I)<M8THEN 5615
: M8=D0(I)
5615 IF K(I)<M7THEN 5625
: M7=K(I)
5625 IF K(I)*B2(C)<M8THEN 5640
: M8=K(I)*B2(C)
5640 H9=H9+1
: I8=I8+K(I)
: IF D(I)=0THEN 5665
: I7=I7+ABS((K(I)-D(I))/D(I))
5665 IF I=K3THEN 5675
: IF C<>P2THEN 5700
5675 I7(H8)=I7/H9
: I8(H8)=I8
: IF I5=0THEN 5700
: K8(H8)=(I8-I5)/I5
5700 IF I=K5THEN 5710
: IF C<>P2THEN 5740
5710 IF I6(H8)=0THEN 5720
: K9(H8)=(I6(H8)-F8)/I6(H8)
5720 F8=I6(H8)
: I5(H8)=I5
: I5,I7,I8,H9=0
: H8=H8+1
5740 C=C+1
: IF C<=PTHEN 5755
: C=1
5755 NEXT I
: GOSUB '35("PRINTING REPORT")
: GOSUB 4995
: GOSUB 5010
: M9=SGN(K3)
: G7=12+10*M9
: M6=(1-M9)*10
: K6=H8-1
: CONVERT STR(K1$,LEN(K1$)-1,2)TO H8
: H8=H8+1900
: IF C6<=P2THEN 5835
: H8=H8+1
5835 PRINT HEX(0A0A)
: PRINT TAB(6+M6);"BASE";
: K=18+3*(1-M9)
: FOR I=0TO K6-1
: PRINT TAB(I*G7+K);"**";H8+I;"**";
: NEXT I
: PRINT
: PRINT TAB(M6);" PER INDEX";
: Q6$=" SALES FORECAST"
: K=14+M6
: IF M9=1THEN 5900
: Q6$="FORECAST"
5900 FOR I=0TO K6-1
: PRINT TAB(I*G7+K);Q6$;
: NEXT I
: PRINT
: GOSUB 4915
: H8=P2+1-P*(1-SGN(P-P2))
: H9=C6-H8-.5*P*(SGN(C6-H8+.5)-1)
: C=2-H8-.5*P*(SGN(1.5-H8)-1)
: FOR J=1TO P
: GOSUB '32
: PRINT TAB(M6);
: PRINTUSING " ### #.##",P$(C),B(C);
: FOR I=0TO K6-1
: K=J+I*P-H9
: IF K<=0THEN 6040
: IF K>K5THEN 6040
: IF K<=K3THEN 6020
: PRINT TAB(I*G7+22);
: PRINTUSING 4040,D(K);
: GOTO 6040
6020 PRINT TAB(I*G7+12);
: PRINTUSING 4045,K(K),FNF(D(K));
: IF K<=K3-K4THEN 6040
: PRINT ">";
6040 NEXT I
: PRINT
: C=C+1
: IF C<=PTHEN 6065
: C=1
6065 NEXT J
: GOSUB 4915
: PRINT "TOTAL";
: FOR I=0TO K6-1
: IF 1+P*I-H9<=K3THEN 6115
: PRINT TAB(I*G7+22);
: PRINTUSING 4040,I5(I+1);
: GOTO 6125
6115 PRINT TAB(I*G7+12);
: PRINTUSING 4045,I8(I+1),FNF(I5(I+1));
6125 NEXT I
: PRINT
: GOSUB 4915
: IF K3=0THEN 6235
: PRINT "AVG % MONTHLY ERROR";
: FOR I=0TO K6-1
: IF 1+P*I-H9>K3THEN 6180
: PRINT TAB(I*G7+25);
: PRINTUSING 4050,FNP(I7(I+1));
6180 NEXT I
: PRINT
: PRINT "NET % YEARLY ERROR";
: FOR I=0TO K6-1
: IF 1+P*I-H9>K3THEN 6220
: PRINT TAB(I*G7+25);
: PRINTUSING 4050,FNP(K8(I+1));
6220 NEXT I
: PRINT
6235 PRINT "NET YEARLY TREND %";
: FOR I=0TO K6-1
: PRINT TAB(I*G7+25);
: PRINTUSING 4050,FNP(K9(I+1));
: NEXT I
: PRINT
: PRINT "YEAR-END DESEAS. DEM.";
: FOR I=0TO K6-1
: PRINT TAB(I*G7+22);
: PRINTUSING 4040,FNF(I6(I+1));
: NEXT I
: PRINT
: GOSUB '32
: PRINT HEX(0A)
: IF K3=K4THEN 6330
: PRINT HEX(0A);"FINAL SAFETY FACTOR ";.01*INT(100*D0+.5)
: PRINT "FINAL TREND PERCENT ";FNP(D1);"%"
6330 IF I9<=0THEN 6360
: IF B$="C"THEN 6350
: PRINT "EFFECTIVE TREND PERCENT ";.01*INT(1E4*D7+.5);"%"
: GOTO 6360
6350 PRINT "*** ERROR IN CALCULATION OF EFFECTIVE TREND PERCENT ***"
6360 PRINT HEX(0A0A0E);"CONTROL PARAMETERS"
: PRINT HEX(0A)
: IF K3=K4THEN 6395
: PRINT "MINIMUM D. D. SMOOTHING RATE ";A
: PRINT "DAMPING FACTOR FOR D. D. SMOOTHING ";A0
: PRINT "DEMAND FILTER LIMIT ";B
: PRINT "TRACKING SIGNAL LIMIT ";B3
6395 PRINT "TREND TYPE ";A4$
: IF K3=K4THEN 6440
: PRINT "TREND % SMOOTHING RATE ";A1
: PRINT "SAFETY FACTOR SMOOTHING RATE ";A2
: PRINT "MIN. % OF D. D. FOR SAFETY FACTOR ";A3*100;"%"
: PRINT "MAX. % OF D. D. FOR SAFETY FACTOR ";A4*100;"%"
6425 PRINT "MAX. % OF D. D. FOR DYING ITEM SAFETY FACTOR ";A5*100;"%"
: GOSUB '32
6440 PRINT HEX(0A0A0E);"INITIAL VALUES"
: $UNPACK(F=HEX(610461046104510451045303500260046004A001A001))A6$()TO D,D0,
G2,G1,G,D1,C0,B0,B1,A1$,A0$
: PRINT HEX(0A);"DESEASONALIZED DEMAND ";D
: PRINT "SAFETY FACTOR ";D0
: PRINT "MEAN ABSOLUTE DEVIATION ";G2
: PRINT "MEAN SIGNED DEVIATION ";G1
6470 PRINT "VARIABLE TREND ";G
: PRINT "TREND PERCENT ";FNP(D1);"%"
: PRINT "LAST PERIOD PROCESSED ";C0
: GOSUB '36(A1$)
: PRINT "DEMAND FILTER HISTORY ";O9$
: GOSUB '36(A0$)
: PRINT "VARIABLE TREND HISTORY ";O9$
: IF I9=0THEN 6525
: PRINT "TARGET SALES ";I9
6525 IF K2$(2)="0"THEN 6585
: IF K2$(2)="2"THEN 6560
: GOSUB '32
: GOSUB '35("PRINTING SEASONAL GRAPH")
: O6$="S"
: GOSUB 4100
6560 IF K2$(2)="1"THEN 6585
: GOSUB '32
: GOSUB '35("PRINTING DESEASONALIZED GRAPH")
: O6$="D"
: GOSUB 4100
6585 LOAD TM5$4000,9999
6605 DEFFN'192
: B$="S"
: IF C0=CTHEN 7140
: B$="Z"
: IF B(C)=0THEN 7135
: A$,B$,B1$=" "
: ROTATE(A0$,1)
: AND (A0$,FE)
: ROTATE(A1$,1)
: AND (A1$,FE)
: ROTATE(A2$,1)
: AND (A2$,FE)
: A8=(C4-D*B(C))*(1+.3*B(C))/(B(C)+.3)
: A9=ABS(A8)
: IF C0<1THEN 7160
: A6=C-C0
: IF A6>0THEN 6750
: A6=A6+P
6750 IF A6=1THEN 6765
: B$="M"
6765 % LOGIC TO CHECK FOR SEASONAL ITEM IN LAST MONTH WOULD GO HERE
6780 A6=D*A3
: IF G2<A6THEN 6800
: A6=G2
6800 IF A9<B*A6THEN 6855
: A6=0
: XOR (A1$,01)
: A6$=HEX(02)
: AND (A6$,A1$)
: IF A6$=HEX(02)THEN 6855
: B$="D"
: RETURN
6855 G1=.9*G1+.1*A8
: G2=.9*G2+.1*A9
: A6=A
: IF G2=0THEN 6930
: A6=ABS(G1)/G2
: IF A6<B3THEN 6905
: XOR (A2$,01)
6905 IF A0=0THEN 6915
: A6=A6*A0
6915 IF A6>ATHEN 6930
: A6=A
6930 A8=D
: D=(1-A6)*D+A6*C4/B(C)
: A8=D-A8
: D0=(1-A2)*D0+A2*A9
: IF D0>D*A3THEN 6985
: D0=D*A3
: B1$="L"
6985 IF D0<D*A4THEN 7010
: D0=D*A4
: B1$="H"
7010 IF A4$="N"THEN 7045
: IF D<>0THEN 7035
: D1=0
: GOTO 7045
7035 D1=(1-A1)*D1+A1*A8/D
7045 G=(1-A6)*G+A6*A8
: IF G>0THEN 7075
: XOR (A0$,01)
7075 A6$=HEX(0F)
: AND (A6$,A0$)
: IF A6$>HEX(0C)THEN 7105
: IF A6$=HEX(07)THEN 7105
: IF A6$<>HEX(0B)THEN 7135
7105 A$="D"
: IF D0<D*A5THEN 7135
: D0=D*A5
: B1$="D"
7135 C0=C
7140 RETURN
7160 A0$,A1$,A2$=HEX(00)
: A6,A8=0
: IF A4$="N"THEN 7190
: D1=0
7190 G=0
: IF ABS(C0)+C4=0THEN 7140
: D=(ABS(C0)*D+C4/B(C))/ABS(C0-1)
7215 A8=A8+1
: IF D>=B1(1,A8)THEN 7215
: D0=D*B1(2,A8)
: G2=D0
: G1=0
: C0=C0-1
: IF C0=-3THEN 7135
: RETURN
7280 DEFFN'173
: B$=" "
: IF K9=0THEN 7545
: IF INT(-C5)=-1THEN 7315
: B$="A"
7315 GOSUB 7870
: INIT(00)D6$(),D7$()
: CONVERT STR(K9$,1,2)TO F7
: D8,F9=F7
: D6=D
: IF D>0THEN 7375
: D6,D7,D9=0
: B$="D"
: RETURN
7375 D7=D1
: E7=D*D7
: IF A4$="F"THEN 7395
: D7,E7=0
7395 IF I9=0THEN 7415
: GOSUB 7600
7415 A6=B(F7)*D6*(1+D7*.5)
: A7=A6+C8*D6*SQR(B(F7))
: A8=A7-F6
: IF A8>0THEN 7445
: A8=0
7445 F6=F6+A8-A6
: $PACK(F=D7$)D7$(F9-D8+1)FROMA6,A7,A8
: IF D7>0THEN 7480
: D6=D6*(1+D7)
: GOTO 7485
7480 D6=D6+E7
7485 IF F7<>P2THEN 7510
: GOSUB 7560
: $PACK(F=D6$)D6$(-INT(-F9/P))FROMD6,D9
7510 F7=F7+1
: F9=F9+1
: IF F7<=PTHEN 7530
: F7=1
7530 IF F9<D8+K9THEN 7415
: GOSUB 7560
7545 RETURN
7560 D9=0
: IF F8=0THEN 7575
: D9=(D6-F8)/F8
7575 F8=D6
: RETURN
7600 IF K9>1THEN 7630
: IF B(F7)=0THEN 7840
: D7=2*(I9/(D*B(F7))-1)
: GOTO 7825
7630 D7,E7,A7,A8=0
: FOR A6=D8TO D8+K9-1
: D9=A6-INT((A6-1)/P)*P
: A7=A7+B(D9)
: A8=A8+B(D9)*(A6-D8)
: NEXT A6
: IF A7*D>I9THEN 7725
: IF A8=0THEN 7840
: D7=(-A7*.5-A8+SQR(A7*A7*.25+A8*A8-A7*A8+2*A8*I9/D))/A8
: E7=D*D7
: RETURN
7725 IF I9<=D*.5*B(F7)THEN 7840
7740 A7=B(D8)
: A8=0
: A9=1
: FOR A6=D8+1TO D8+K9-1
: D9=A6-P*INT((A6-1)/P)
: A8=A8+B(D9)*A9*(A6-D8)
: A9=A9*(1+D7)
: A7=A7+B(D9)*A9
: NEXT A6
: A8=D*((1+.5*D7)*A8+.5*A7)
: IF A8=0THEN 7840
: A7=(D*(1+.5*D7)*A7-I9)/A8
: D7=D7-A7
: IF ABS(A7)>=.001THEN 7740
7825 IF D7<=-1THEN 7840
: RETURN
7840 D7=D1
: B$="C"
: RETURN
7870 IF D0*D=0THEN 7930
: C8=C5
: IF INT(-C8)=-1THEN 7890
: C8=.95
7890 C8=D/D0*(1-C8)
: IF C8>=.5THEN 7930
: PACK(.####)C6$FROMC8
: MAT SEARCHC6$(),>STR(C6$,1,2)TO P7$()STEP 2
: C9=.5*VAL(STR(P7$(1),2))+.5
: IF C9>1THEN 7945
7930 C8=0
: RETURN
7945 UNPACK(.####)C6$(C9-1)TO D6
: UNPACK(.####)C6$(C9)TO D8
: UNPACK(#.#)C7$(C9-1)TO D7
: UNPACK(#.#)C7$(C9)TO D9
: C8=((D9-D7)/(D8-D6)*(C8-D6)+D7)*(D0/D)
: RETURN
7990 DEFFN'172
: D6$=HEX(51045303)
: D7$=HEX(510451045104)
: RETURN
8015 DEFFN'32
: Q6$=" "
: KEYIN Q6$,8030,8035
8030 RETURN
8035 IF Q6$=HEX(1F)OR Q6$=HEX(7E)THEN GOSUB '31
: RETURN
8045 DEFFN'29"Q$=";HEX(22);"FCST128A";HEX(22);":SCRATCH TQ$:SAVET$()Q$";HEX(0D
)