10 !PROGRAM FUTURE COPYRIGHT BY ROY D. HARRIS 1969 THIS VERSION WRITTEN FOR RSTS-11 BY ROD MISHLER 10/4/72 20 !F% - - - - TYPE OF FORECAST WANTED N% - - - - NUMBER OF PERIODS OF HISTORY M% - - - - NUMBER OF PERIODS OF FORECAST S1%- - - - NUMBER OF PERIODS IN FIRST SEASON (MAX OF 50) 30 !S2%- - - - NUMBER OF PERIODS IN SECOND SEASON (MAX OF 50) O - - - - EXPONENTIAL SMOOTHING FACTOR R% - - - - NUMBER OF PERIODS IN MOVING AVERAGE I%,J%- - PERIOD NUMBER INDICIES 40 !P(99)- - - MATRIX CONTAINING PAST HISTORY (MAX OF 99) P% - - - - PERIOD SHIFT (SUBTRACT P FROM I) S% - - - - STARTING PERIOD E% - - - - ENDING PERIOD 50 !B,B1,B2- - SLOPE IN REGRESSION EQUATION Y=A+B*X A,A1,A2- - CONSTANT IN REGRESSION EQUATION (SEASON 1&2) T,T1,T2,T3 SUMMATION OF PAST HISTORY S,S1,S2(I) MATRIX CONTAINING SEASONAL HISTORY 60 !Y - - - - FORECAST VALUE G% - - - - SEASON 1, 2 INDICATOR %,X2%- - NUMBER OF SEASONS OF HISTORY AVAILABLE V - - - - AVERAGE 70 ON ERROR GOTO 1040 80 DIM P(99),S(99),S1(99),S2(99),A$(0),B$(0) :C$=" ## #######.###" :D$=" ## #######.### #######.###" 90 INPUT"NAME PLEASE";A$ 100 INPUT"DO YOU WANT INSTRUCTIONS";B$ :PRINT 110 IF LEFT(B$,2)="NO" THEN 240 ELSE IF LEFT(B$,3)="YES" THEN 120 ELSE PRINT"YES OR NO PLEASE." :GOTO100 120 PRINT"THIS PROGRAM WILL AID THE USER IN FORECASTING FUTURE VALUES" :PRINT"FR PAST HISTORY. THIS IS ACCOMPLISHED BY THREE DIFFERENT" :PRINT"METHODS: TREND, SEASONAL AND SMOOTHING ANALYSIS." 130 PRINT"TREND ANALYSIS USES ARITHMETIC MEAN AND LEAST-SQUARES "; :PRINT"REGRESSION." :PRINT"SEASONAL ANALYSIS USES SEASONAL MEAN AND REGRESSION." 140 PRINT"SMOOTHING ANALYSIS USES MOVING AVERAGES AND EXPONENTIALLY" :PRINT"SMOOTHED AVERAGES." :PRINT"DATA FOR HISTORY PERIODS MUST BE ENTERED BETWEEN LINES" 150 PRINT"2000 AND 3000. FOR EXAMPLE :" :PNT :PRINT"2000 DATA 45.7,4322" :PRINT"2001 DATA 8963,3.4" :PRINT :PRINT"(THIS MEANS DATA 45.7 AND 4322 ARE ON LINE 2000 AND" 160 PRINT"DATA 8963 AND 3.4 ARE ON LINE 2001.)" :PRINT"SELECT THE NUMBER OF HISTORY PERIODS AND ENTER AS AN INTEGER." :PRINT"SELECT THE TYPE IF ANALYSIS WANTED, USING THE FOLLOWING CODE:" 170 PRINTTAB(7);"1 : TREND ANALYSIS" :PRINTTAB(7);"2 : SEASONAL ANALYSIS" :PRINTTAB(7);"3 : SMOOTHING ANALYSIS" 180 PRINT"DATA MUST BE ENTERED BORE RUNNING THE PROGRAM." 190 INPUT"DO YOU DESIRE A SAMPLE RUN";B$ 200 IF LEFT(B$,3)="YES" THEN 210 ELSE 220 210 F%=1 :M%=12 :N%=24 :GOTO410 220 IF LEFT(B$,2)="NO" THEN 240 230 PRINT"YES OR NO, PLEASE." :GOTO190 240 INPUT"NUMBER OF HISTORY PERIODS";N% 250 INPUT"TYPE OF ANALYSIS WANTED";F% 260 ON F% GOTO 270,280,340 270 INPUT"FORECAST HOW MANY PERIODS";M% :GOTO410 280 INPUT"LENGTH OF SEASON ONE";S1% 290 INPUT"LENGTH OF SEASON TWO";S2% 300 IF (S1%+S2%)N% 400 IF R%<0% OR R%>N% GOTO370 410 OPEN"KB:"FOR OUUT AS FILE 1 420 PRINT#1 FOR I=1 TO 4 430 PRINT#1,"PROGRAM FUTURE FOR ";A$,DATE$(0) :ON F% GOTO 440,450,460 440 PRINT#1,"TREND ANALYSIS" :GOTO470 450 PRINT#1,"SEASONAL ANALYSIS" :GOTO470 460 PRINT#1,"SMOOTHING ANALYSIS" :PRINT#1,"HISTORY DATA FOR";N%;"PERIODS" 470 PRINT#1,"PERIOD","DATA" 480 RESTORE 490 MAT READ P(N%) :PRINT#1,USINGC$,I%,P(I%) FOR I%=1%TON% 500 PRINT#1 :ON F% GOTO 510,560,920 510 S%=1% :E%=N% :P%=0% : GOSUB1060 520 PRINT#1,"TREND ANALYSIS RESULTS" PRINT#1,"FORECAST BASED ON";N%;"PERIODS OF HISTORY" :PRINT#1,"FORECAST";M%;"PERIODS INTO FUTURE" 530 PRINT#1,TAB(14);"-------FORECAST-------" :PRINT#1,"PERIOD","AVERAGE","REGRESSION" 540 PRINT#1,USING D$,N%+I%,V,A+B*(N%+I%) FOR I%=1%TOM% :PRINT#1 550 PRINT#1,"REGRESSION FORECAST=";A;"+";B;"X PERIOD" :GOTO1000 560 PRINT#1,"SEASONAL ANALYSIS RESULTS" :PRINT#1,"FORECAST BASED ON";N%;"PERIODS OF HISTORY" :PRINT#1,"SEASON ONE" 570 PRINT#1,"FORECAST";S1%;"PERIODS INTFUTURE" :PRINT#1,"SEASON TWO" :PRINT#1,"FORECAST";S2%;"PERIODS INTO FUTURE" 580 PRINT#1,TAB(18);"-------FORECAST-------" :PRINT#1," PERIOD"," AVERAGE"," REGRESSION" 590 S%,G%=1 :A1,A2,B1,B2,X1%,X2%=0 :E%=S1% :P%=S% 600 IF (E%-N%)>0% GOTO 700 610 IF G%=2% GOTO660 620 GOSUB1060 630 B1=B1+B :X1%=X1%+1% : A1=A1+A 640 S1(I%-S%+1%)=S1(I%-S%+1%)+P(I%) FOR I%=S%TOE% 650 G%=2% :S%=E%+1% :E%=S%+S2%-1% :P%=S% :GOTO600 660 GOSUB 1060 670 B2=B2+B : X2%=X2%+ :A2=A2+A 680 S2(I%-S%+1%)=S2(I%-S%+1%)+P(I%) FOR I%=S%TOE% 690 G%=1% :S%=E%+1% :E%=S%+S1%-1% :P%=S% :GOTO600 700 B1=B1/X1% :B2=B2/X2% :A1=A1/X1% :A2=A2/X2% 710 S1(I%)=S1(I%)/X1% FOR I%=1%TOS1% 720 S2(I%)=S2(I%)/X2% FOR I%=1%TOS2% 730 ON G% GOTO 740,770 740 A=A1-B1 :B=B1 750 S(I%)=S1(I%) FOR I%=1%TOS1% 760 GOTO790 770 A=A2-B2 :B=B2 780 S(I%)=S2(I%) FOR I%=1%TOS2% 790 I%=S% 800 PRINT#1,G%; :PRINT#1,USING D$,I%,S(I%-S%+1%),A+B*(I%-S%+1%) 810 I%=I%+1% :GOTO800 UNLE I%=E%+1% 820 ON G% GOTO 860,830 830 A=A1-B1 :B=B1 :G%=1% :S%=E%+1% :E%=S%+S1%-1% 840 S(I%)=S1(I%) FOR I%=1%TOS1% 850 GOTO870 860 A=A2-B2 :B=B2 :G%=2% :S%=E%+1% :E%=S%+S2%-1% 870 S(I%)=S2(I%) FOR I%=1%TOS2% 880 I%=S% 890 PRINT#1,G%; :PRINT#1,USING D$,I%,S(I%-S%+1%),A+B*(I%-S%+1%) 900 I%=I%+1% :GOTO890 UNLESS I%>E% 910 PRINT#1,"SEASON ONE" :PRINT#1,"REGRESSION FORECAST=";A1;"+";B1;"X PERIOD" :PRINT#1,"SEASON TWO" :PRINT#1,"REGRESSION FORECAST=";A2;"+";B2X PERIOD" :GOTO1000 920 PRINT#1,"SMOOTHING ANALYSIS RESULTS" :PRINT#1,"FORECAST BASED ON";N%;"PERIODS OF HISTORY" :PRINT#1,"FORECAST 1 PERIOD INTO FUTURE" :PRINT#1,TAB(14);"-------FORECAST-------" 930 PRINT#1,TAB(14);R%;"PERIOD",O;"FACTOR" :PRINT#1,TAB(14);"MOVING","EXPONENTIAL" :PRINT#1,"PERIOD","AVERAGE","SMOOTHING" 940 S%=N%-R%+1% :E%=N% :T=0% 950 FOR I%=S%TOE% 960 T=T+P(I%) :V=T/R% :NEXT I% 970 Y=P(1) 980 Y=(O*P(I%))+((1%-O)*Y) FOR I%=2%TON% 90 PRINT#1,USING D$,N%+1%,V,Y 1000 PRINT#1 FOR I=1%TO4% :CLOSE 1 1010 INPUT"DO YOU WISH TO RUN PROGRAM AGAIN";B$ 1020 IF LEFT (B$,3)="YES" THEN 250 ELSE IF LEFT(B$,2)="NO" THEN 3001 1030 PRINT"ANSWER YES OR NO, PLEASE." :GOTO1010 1040 IF ERR=8 THEN PRINT"WAITING FOR LINE PRINTER" ELSE ON ERROR GOTO0 1050 SLEEP(10) :RESUME 1060 T,T1,T2,T3=0 1070 FOR I%=S%TOE% 1080 Z%=I%-P% 1090 T=T+P(I%) :T1=T1+Z% :T2=T2+Z%^2 :T3=T3+P(I%)*Z% 1100 NEXT I% 1110 A=(T2*T-T1*T3)/((E%-S%+1%)2-T1^2) 1120 B=((E%-S%+1%)*T3-T1*T)/((E%-S%+1%)*T2-T1^2) 1130 V=T/N% :RETURN 2000 DATA 1447,1384,1219,1047,887,759,814,834,1009,1133,1146,1401, 1421,1328,1350,1022,1105,877,913,926,1104,1234,1329,1609 3001 END