10  COM N$[7],R,D$[45],A[100,6],A$[3],M$[15]
20  REM
30  REM
40  REM           POWER SERIES REGRESSION CURVE
50  REM                 WITH X AXIS OFFSET
60  REM
70  REM          WRITTEN BY CORT VAN RENSSELAER
80  REM             C404             13NOV73
90  REM
100  REM HEWLETT-PACKARD 36793A, 6/74
110  REM
120  PRINT "WANT EXPLANATION";
130  INPUT A$
140  IF A$[1,1]="N" THEN 1610
1000  REM
1010  REM***************EXPLANATION SECTION*********************
1020  REM
1030  PRINT LIN(1)
1040  PRINT "ONE OF THE MOST POPULAR FORECASTING METHODS INVOLVES THE"
1050  PRINT "EXTENSION OF PAST TRENDS BY REGRESSION ANALYSIS. A MATHE-"
1060  PRINT "MATICAL CURVE WHICH CLOSELY MATCHES THE OBSERVED DATA IS"
1070  PRINT "DETERMINED BY THE LEAST SQUARES METHOD. THE FORMULA FOR"
1080  PRINT "THIS CURVE IS THEN USED TO CALCULATE FUTURE VALUES."
1090  PRINT 
1100  PRINT "THE POWER FUNCTION IS A PARTICULARLY USEFUL REGRESSION"
1110  PRINT "ANALYSIS FORMULA FOR FORECASTING GROWTH TRENDS. IT REP-"
1120  PRINT "RESENTS A LOGICAL GROWTH CURVE BECAUSE ITS GROWTH RATE"
1130  PRINT "DECREASES AS ITS MAGNITUDE INCREASES. IT PRODUCES A SIM-"
1140  PRINT "PLE MATHEMATICAL APPROXIMATION TO THE 'GOMPERTZ' OR 'S'"
1150  PRINT "CURVE, OFTEN USED BY STATISTICIANS TO PORTRAY GROWTH. THE"
1160  PRINT "POWER FUNCTION PLOTS AS A STRAIGHT LINE ON LOG-LOG COOR-"
1170  PRINT "DINATE GRAPH PAPER. A STRAIGHT LINE PROJECTION IS VERY"
1180  PRINT "DESIRABLE BECAUSE IT IS EASY TO VISUALIZE."
1190  PRINT 
1200  PRINT "THE DATA FOR MOST FORECASTING APPLICATIONS IS REPRESENTED"
1210  PRINT "BY A TIME SERIES IN WHICH THE X AXIS VALUES ARE EXPRESSED"
1220  PRINT "IN YEARS, QUARTERS, MONTHS, WEEKS OR DAYS. THE OBSERVED"
1230  PRINT "DATA OFTEN BEGINS AT A LATER TIME THAN THE ACTUAL BEGIN-"
1240  PRINT "NING OF THE SERIES. WHEN THIS IS THE CASE, THE CLOSEST FIT"
1250  PRINT "BETWEEN OBSERVED DATA AND THE POWER SERIES CURVE CAN USU-"
1260  PRINT "ALLY BE OBTAINED BY OFFSETTING THE X AXIS SO THAT THE INI-"
1270  PRINT "TIAL VALUE APPROXIMATES THE ACTUAL BEGINNING OF THE TIME"
1280  PRINT "SERIES. PROGRAM 'PSRC' AUTOMATES THE PROCESS FOR DOING"
1290  PRINT "THIS."
1300  PRINT 
1310  PRINT "THE PROGRAM CALCULATES THE INDEX OF DETERMINATION (MEAS-"
1320  PRINT "URE OF THE CLOSENESS OF THE FIT) FOR EACH INCREASING VALUE"
1330  PRINT "OF X OFFSET, THEN DETERMINES THE VALUES AND DIMENSIONS FOR"
1340  PRINT "PLOTTING THE OBSERVED DATA AND THE FORECAST PROJECTION."
1350  PRINT 
1360  PRINT "A RESULT OF OFFSETTING THE X VALUES IS TO COMPRESS THE HOR-"
1370  PRINT "IZONTAL AXIS OF THE PLOTTED DATA. IT IS NECESSARY TO EXPAND"
1380  PRINT "THE X AXIS GRID LINES AND TO PLOT THEM MANUALLY IN ORDER TO "
1390  PRINT "COMPENSATE FOR THIS. (Y AXIS GRID LINES CAN BE OBTAINED"
1400  PRINT "FROM REGULAR MULTICYCLE LOGARITHMIC GRAPH PAPER.) X AXIS"
1410  PRINT "LINEAR DIMENSIONS ARE CALCULATED BY THE PROGRAM."
1420  PRINT 
1430  PRINT "THE FIRST STEP IN RUNNING THE PROGRAM IS TO INPUT THE X"
1440  PRINT "AND Y VALUES FOR THE DATA. THEN AN AUTOMATIC OR MANUAL"
1450  PRINT "COEFFICIENT CALCULATION MODE IS SELECTED. IN THE AUTOMATIC"
1460  PRINT "MODE THE PROGRAM PROCEEDS TO THE END WITHOUT OPERATOR"
1470  PRINT "INTERVENTION, EXCEPT FOR ENTERING TWO CONSTANTS. THE MAN-"
1480  PRINT "UAL MODE PERMITS ANY DESIRED NUMBER OF X OFFSET VALUES TO"
1490  PRINT "BE CALCULATED AND THEIR COEFFICIENTS EXAMINED."
1500  PRINT 
1510  PRINT "THE OPERATOR OF THE PROGRAM MUST MAKE SURE THAT THE AUTO-"
1520  PRINT "MATICALLY SELECTED X OFFSET VALUE IS LOGICAL. IF IT DOES"
1530  PRINT "NOT CLOSELY APPROXIMATE THE ACTUAL BEGINNING OF THE TIME"
1540  PRINT "SERIES A SECOND CALCULATION FOR THE DATA TO BE PLOTTED"
1550  PRINT "SHOULD BE MADE USING THE MANUAL MODE OF OPERATION."
1560  PRINT 
1570  PRINT "SINCE A POWER FUNCTION HAS A DECREASING RATE OF GROWTH AS"
1580  PRINT "ITS MAGNITUDE INCREASES, IT IS OFTEN USEFUL TO KNOW THE"
1590  PRINT "GROWTH RATE FOR SPECIFIC X AXIS VALUES. THESE DATA ARE"
1600  PRINT "CALCULATED AND PRINTED BY PROGRAM 'PSRC'."
1610  PRINT LIN(2)
1620  PRINT SPA(20);"POWER SERIES REGRESSION CURVE"
1630  PRINT SPA(20);"     WITH  X AXIS OFFSET"
1640  PRINT 
1650  N$="PSRC"
1660  R=1690
1670  D$="DMY"
1680  CHAIN "SYSDAT"
1690  PRINT SPA(27);D$
1700  PRINT LIN(1)
2000  REM
2010  REM****************DATA INPUT SECTION***************
2020  REM
2030  PRINT "REPRESENTATION OF X VALUES   (BY DAY - 'D',"
2040  PRINT "WEEK-'W', MONTH-'M', QUARTER-'Q', YEAR-'Y')";
2050  INPUT B$
2060  IF B$#"D" THEN 2080
2070  GOTO 2180
2080  IF B$#"W" THEN 2100
2090  GOTO 2180
2100  IF B$#"Y" THEN 2120
2110  GOTO 2310
2120  IF B$#"Q" THEN 2140
2130  GOTO 2450
2140  IF B$#"M" THEN 2160
2150  GOTO 2760
2160  PRINT "INCORRECT REPRESENTATION SELECTION"
2170  GOTO 2030
2180  REM:  SEQUENTIAL DATA
2190  PRINT "X VALUE OF FIRST DATA SET - '1'";
2200  INPUT V
2210  IF V<9000 THEN 2240
2220  PRINT "MAXIMUM VALUE IS 9000"
2230  GOTO 2190
2240  GOSUB 3070
2250  FOR I=1 TO 1000
2260  A[I,1]=V-1+I
2270  PRINT  USING "#,3X4D5X";A[I,1]
2280  INPUT A[I,2]
2290  IF A[I,2]<0 THEN 3140
2300  NEXT I
2310  REM: YEARLY DATA
2320  PRINT "X VALUE OF FIRST DATA SET - '1960'";
2330  INPUT V
2340  IF V<1000 THEN 2360
2350  IF V<2001 THEN 2380
2360  PRINT "RANGE OF INITIAL YEAR VALUES IS 1000 TO 2000"
2370  GOTO 2320
2380  GOSUB 3070
2390  FOR I=1 TO 1000
2400  A[I,1]=V-1+I
2410  PRINT  USING "#,3X4D5X";A[I,1]
2420  INPUT A[I,2]
2430  IF A[I,2]<0 THEN 3140
2440  NEXT I
2450  REM: QUARTERLY DATA
2460  PRINT "X VALUE OF FIRST DATA SET - '1960 1'";
2470  INPUT V
2480  V1=INT(V/10)
2490  V2=V-V1*10
2500  IF V2<1 THEN 2520
2510  IF V2<5 THEN 2540
2520  PRINT "QUARTERS MUST BE REPRESENTED BY '1', '2', '3', OR '4'"
2530  GOTO 2450
2540  IF V1<1000 THEN 2560
2550  IF V1<2001 THEN 2580
2560  PRINT "RANGE OF INITIAL YEAR VALUES IS 1000 TO 2000"
2570  GOTO 2460
2580  GOSUB 3070
2590  C=1
2600  PRINT  USING "#,X4DXD4X";V
2610  INPUT A[C,2]
2620  A[C,1]=V
2630  IF A[C,2]<0 THEN 3160
2640  V1=INT(V/10)
2650  V2=V-V1*10
2660  IF V2=4 THEN 2730
2670  C=C+1
2680  V=V+1
2690  PRINT  USING "#,X4DXD4X";V
2700  INPUT A[C,2]
2710  A[C,1]=V
2720  GOTO 2630
2730  V=V+7
2740  C=C+1
2750  GOTO 2600
2760  REM:  MONTHLY DATA
2770  PRINT "X VALUE OF FIRST DATA SET - '1960 01'";
2780  INPUT V
2790  V1=INT(V/100)
2800  V2=V-V1*100
2810  IF V2<1 THEN 2830
2820  IF V2<13 THEN 2850
2830  PRINT "MONTHS MUST BE REPRESENTED BY '01' THRU '12'"
2840  GOTO 2770
2850  IF V1<1000 THEN 2870
2860  IF V1<2001 THEN 2890
2870  PRINT "RANGE OF INITIAL YEAR VALUES IS 1000 TO 2000"
2880  GOTO 2770
2890  GOSUB 3070
2900  C=1
2910  PRINT  USING "#,4DXDD4X";V
2920  INPUT A[C,2]
2930  A[C,1]=V
2940  IF A[C,2]<0 THEN 3160
2950  V1=INT(V/100)
2960  V2=V-V1*100
2970  IF V2=12 THEN 3040
2980  C=C+1
2990  V=V+1
3000  PRINT  USING "#,4DXDD4X";V
3010  INPUT A[C,2]
3020  A[C,1]=V
3030  GOTO 2940
3040  V=V+89
3050  C=C+1
3060  GOTO 2910
3070  REM: SUBROUTINE
3080  PRINT 
3090  PRINT "INPUT '-1' FOR Y VALUE FOLLOWING LAST DATA SET"
3100  PRINT 
3110  PRINT " X VALUE   Y VALUE"
3120  PRINT 
3130  RETURN 
3140  N=I-1
3150  GOTO 4000
3160  N=C-1
4000  REM
4010  REM*************COEFFICIENT CALCULATION SECTION***************
4020  REM
4025  D1=D3=0
4030  PRINT 
4040  PRINT "MANUAL-'M', OR AUTOMATIC-'A' COEFFICIENT CALCULATION MODE";
4050  INPUT C$
4060  PRINT LIN(1)
4070  PRINT SPA(22);"COEFFICIENT CALCULATION"
4080  PRINT 
4090  PRINT "   X      INDEX OF      DIFFERENCE     A COEF-";
4100  PRINT "      B COEF-  STD ERROR"
4110  PRINT "OFFSET  DETERMINATION                  FICIENT";
4120  PRINT "      FICIENT    OF EST"
4130  PRINT 
4140  G=0
4150  H=9
4160  FOR J=G TO H
4170  X3=X5=Y3=Y5=Z5=S2=0
4180  FOR I=1 TO N
4190  X2=LOG(J+I)
4200  X3=X3+X2
4210  X5=X5+(X2^2)
4220  Y2=LOG(A[I,2])
4230  Y3=Y3+Y2
4240  Y5=Y5+(Y2^2)
4250  Z5=Z5+(X2*Y2)
4260  NEXT I
4270  B=(N*Z5-X3*Y3)/(N*X5-(X3^2))
4280  A=EXP((Y3-B*X3)/N)
4290  D=((B^2)*(X5-(X3^2)/N))/(Y5-(Y3^2)/N)
4320  D2=D-D1
4330  D1=D
4340  FOR I=1 TO N
4350  IF A#0 THEN 4400
4360  PRINT "VALUE OF A COEFFICIENT TOO SMALL FOR COMPUTER TO HANDLE"
4370  PRINT "USE X OFFSET VALUE = ";J-2
4380  C$="M"
4390  GOTO 5000
4400  S2=S2+((A*((J+I)^B)-A[I,2])/(A*((J+I)^B)))^2
4410  NEXT I
4420  S=(S2/(N-2))^.5
4430  PRINT  USING "#,4D,7X,D.5D,7X,S.5D,5X,D.5DE,3X";J,D,D2,A
4440  PRINT  USING "2D.5D,5X,D.2D";B,S
4450  IF C$="M" THEN 4490
4453  REM: COUNTER TO TEST FOR TRUE PEAK OF INDEX OF DETERMINATION
4460  IF D2>0 THEN 4470
4462  D3=D3+1
4463  IF D3=10 THEN 5000
4466  GOTO 4490
4470  A1=A
4480  B1=B
4485  J1=J
4490  NEXT J
4500  IF C$="A" THEN 4550
4510  PRINT "MORE";
4520  INPUT A$
4530  IF A$[1,1]#"Y" THEN 5000
4540  GOTO 4580
4550  IF J<50 THEN 4580
4560  PRINT "CONTROL TRANSFERRED TO MANUAL MODE"
4570  C$="M"
4580  G=G+10
4590  H=H+10
4600  GOTO 4160
5000  REM
5010  REM*********GRAPH CALCULATION AND PRINTING SECTION***********
5020  REM
5030  PRINT LIN(1)
5040  PRINT "X OFFSET VALUE WITH HIGHEST INDEX OF DETERMINATION - '29'";
5050  IF C$="M" THEN 5090
5060  PRINT " = ";J1
5070  K=J1
5080  GOTO 5100
5090  INPUT K
5100  PRINT "A COEFFICIENT";
5110  IF C$="M" THEN 5150
5120  PRINT " = ";A1
5130  A=A1
5140  GOTO 5160
5150  INPUT A
5160  PRINT "B COEFFICIENT";
5170  IF C$="M" THEN 5210
5180  PRINT " = ";B1
5190  B=B1
5200  GOTO 5220
5210  INPUT B
5220  PRINT "NUMBER OF TIME INTERVALS TO BE PROJECTED - '8'";
5230  INPUT K1
5240  PRINT "WIDTH OF GRAPH IN MILLIMETERS - '160'";
5250  INPUT W
5260  PRINT LIN(1)
5270  REM: TO CALCULATE Y VALUES, X DIMENSIONS AND RATE OF GROWTH
5280  REM: FOR INPUT DATA
5290  FOR L=1 TO N
5300  X=K+L
5310  A[L,3]=A*X^B
5320  A[L,4]=LOG(X)-LOG(K+1)
5330  A[L,6]=B/X
5340  NEXT L
5350  REM:  TO CALCULATE X VALUES FOR PROJECTION
5360  N1=N+K1
5370  IF B$#"D" THEN 5390
5380  GOTO 5560
5390  IF B$#"Y" THEN 5410
5400  GOTO 5740
5410  IF B$#"Q" THEN 5430
5420  GOTO 5610
5430  REM:  MONTHLY DATA
5440  IF C >= N1 THEN 5780
5450  V1=INT(V/100)
5460  V2=V-V1*100
5470  IF V2=12 THEN 5520
5480  C=C+1
5490  V=V+1
5500  A[C,1]=V
5510  GOTO 5440
5520  V=V+89
5530  C=C+1
5540  A[C,1]=V
5550  GOTO 5440
5560  REM: SEQUENTIAL DATA
5570  FOR L=N+1 TO N1
5580  A[L,1]=A[1,1]+L-1
5590  NEXT L
5600  GOTO 5780
5610  REM: QUARTERLY DATA
5620  IF C >= N1 THEN 5780
5630  V1=INT(V/10)
5640  V2=V-V1*10
5650  IF V2=4 THEN 5700
5660  C=C+1
5670  V=V+1
5680  A[C,1]=V
5690  GOTO 5620
5700  V=V+7
5710  C=C+1
5720  A[C,1]=V
5730  GOTO 5620
5740  REM: YEARLY DATA
5750  FOR L=N+1 TO N1
5760  A[L,1]=A[1,1]+L-1
5770  NEXT L
5780  REM: TO CALCULATE Y VALUES, X DIMENSIONS AND RATE OF GROWTH
5790  REM: FOR PROJECTION
5800  FOR L=N+1 TO N1
5810  X=K+L
5820  A[L,2]=0
5830  A[L,3]=A*X^B
5840  A[L,4]=LOG(X)-LOG(K+1)
5850  A[L,6]=B/X
5860  NEXT L
5870  REM:  TO PRINT X VALUES AND DIMENSIONS AND Y VALUES FOR GRAPH
5880  PRINT "           X AND Y VALUES AND DIMENSIONS FOR GRAPH"
5890  PRINT 
5900  PRINT "    X        X DIM          Y              Y       RATE OF"
5910  PRINT "  VALUE       (MM)       ACTUAL       CALCULATED    GROWTH"
5920  PRINT 
5930  FOR L=1 TO N1
5940  REM: TO CALCULATE X DIMENSIONS
5950  A[L,5]=(A[L,4]/A[N1,4])*W
5960  IF B$[1,1]#"Q" THEN 5980
5970  GOTO 6020
5980  IF B$#"M" THEN 6000
5990  GOTO 6040
6000  PRINT  USING "#,2X,4D,4X,6D.D";A[L,1],A[L,5]
6010  GOTO 6050
6020  PRINT  USING "#,X,4DXD,3X,6D.D";A[L,1],A[L,5]
6030  GOTO 6050
6040  PRINT  USING "#,4DXDD,3X,6D.D";A[L,1],A[L,5]
6050  M1=A[L,2]
6060  M2=1
6070  IF M1=0 THEN 6220
6080  IF M1>.0299 THEN 6110
6090  M$="#,9X,D.4D"
6100  GOTO 6240
6110  IF M1>.299 THEN 6140
6120  M$="#,9X,D.3D,X"
6130  GOTO 6240
6140  IF M1>2.99 THEN 6170
6150  M$="#,9X,D.2D,2X"
6160  GOTO 6240
6170  IF M1>29.9 THEN 6200
6180  M$="#,8X,2D.D,3X"
6190  GOTO 6240
6200  M$="#,3X,7D,5X"
6210  GOTO 6240
6220  PRINT  USING "#,15X"
6230  GOTO 6260
6240  PRINT  USING M$;M1
6250  IF M2=2 THEN 6290
6260  M2=2
6270  M1=A[L,3]
6280  GOTO 6080
6290  PRINT  USING "6X.DD";A[L,6]
6300  NEXT L
6310  PRINT LIN(3)
6320  PRINT "ANOTHER CALCULATION";
6330  INPUT A$
6340  IF A$[1,1]#"Y" THEN 6410
6350  PRINT "COEFFICIENT 'C' OR GRAPH 'G' CALCULATION";
6360  INPUT A$
6370  IF A$="C" THEN 4000
6380  IF A$#"G" THEN 6350
6390  C$="M"
6400  GOTO 5000
6410  END 
