Compucolor.org – Virtual Media

Listing of file='TIMSER.BAS;01' on disk='vmedia/statistics_3-sector.ccvf'

5 REM   TIMSER
7 REM   WRITTEN BY WALTER DEGLER  4/1/79
10 REM   TIME SERIES ANALYSIS
20 DIM D(199,3),S(50),MD(50),A(50),B(50)
25 PLOT 27,24,12,14,6,2
50 GOSUB 2000
999 REM
1000 REM   SELECT PROCEDURE
1005 PLOT 12,14,6,1
1020 MO= TP
1025 PRINT "ENTER NUMBER OF CHOICE:"
1030 PLOT 6,2
1050 PRINT "1) COMPUTE NEW DATA
1075 PRINT "2) ADJUST NEW DATA
1100 PRINT "3) GRAPH DATA
1125 PRINT "4) DISPLAY DATA
1130 PRINT "5) RESET ORIGINAL DATA
1135 PRINT "6) DISPLAY STATISTICS
1140 PRINT "7) END PROGRAM
1145 PRINT
1150 INPUT Z
1160 PLOT 15
1165 B= 1
1175 ON ZGOTO 1220,1500,10000,15060,1550,16000,20000
1200 GOTO 1150
1220 FOR I= 0TO NO- 1:D(I,1)= D(I,2):NEXT
1222 PLOT 12,14,6,1
1225 PRINT "TYPE OF COMPUTATION:"
1230 PLOT 6,2
1250 PRINT "1 - DESEASONALIZE (CENTERED MOVING AVERAGE)
1275 PRINT "2 - TREND (REGRESSION)
1300 PRINT "3 - IRREGULARITIES (SMOOTHING)
1325 PRINT "4 - CYCLES (MOVING AVERAGE)
1350 PRINT "5 - PERIODIC CYCLES (FOURIER REGR.)
1375 INPUT Z
1380 PLOT 15
1400 ON ZGOTO 6020,8000,6000,6000,12000
1475 GOTO 1350
1500 FOR I= 0TO NO- 1:D(I,2)= D(I,2)- D(I,1)+ MN:NEXT
1525 GOTO 1000
1550 FOR I= 0TO NO- 1:D(I,1)= D(I,0):D(I,2)= D(I,0):NEXT
1575 GOTO 1000
1999 REM
2000 REM   INPUT DATA
2025 INPUT "DATA SOURCE (F-FILE OR K-KEYBOARD): ";Z$
2050 IF Z$= "F"THEN 2500
2060 PLOT 27,11
2075 INPUT "NUMBER OF DATA POINTS: ";NO
2080 PLOT 12,15,6,1
2100 PRINT "NUMBER OF DATA POINT, VALUE:"
2110 PLOT 6,3
2125 INPUT "#";I
2150 IF I< 1THEN PLOT 12,27,24:GOTO 2675
2175 PRINT SPC( 6);:PLOT 28
2200 INPUT "";D(I- 1,0)
2210 D(I- 1,2)= D(I- 1,0)
2220 D(I- 1,1)= D(I- 1,0)
2225 GOTO 2125
2500 INPUT "FILE NAME AND TYPE NUMBER: ";F$,T
2525 FILE "R",1,F$,6
2550 GET 1,1,5;NO
2575 FOR I= 0TO NO- 1
2600 GET 1,T,4* I+ 9;D(I,0)
2610 D(I,2)= D(I,0)
2620 D(I,1)= D(I,0)
2625 NEXT
2650 FILE "C",1
2675 INPUT "DATA POINTS PER TIME PERIOD: ";TP
2999 REM
3000 REM   COMPUTE SUM
3025 FOR I= 0TO NO- 1
3050 MN= MN+ D(I,0)
3075 NEXT
3100 MN= MN/ NO
3125 RETURN
5999 REM
6000 REM  COMPUTE CYCLES (OR DESEASONALIZE)
6010 REM
6012 PLOT 12,14,6,2
6015 INPUT "PERIOD: ";MO
6018 PLOT 15
6020 REM   COMPUTE CENTERED MOVING AVERAGE
6025 MO= 2* INT (MO/ 2):K= MO/ 2:N= MO+ MO
6050 SM= D(0,1)+ D(MO,1)
6075 FOR I= 1TO MO- 1
6100 SM= SM+ 2* D(I,1)
6125 NEXT
6150 D(K,2)= SM/ N
6175 FOR I= 0TO NO- MO- 2
6200 SM= SM- D(I,1)- D(I+ 1,1)+ D(I+ MO,1)+ D(I+ MO+ 1,1)
6225 D(K+ I+ 1,2)= SM/ N
6250 NEXT
6275 IF Z< > 1THEN 1000
7000 REM   SORT MOVING AVERAGES OF A COMMON MONTH
7025 FOR I= 0TO MO- 1
7030 CT= 0
7050 K= I+ MO:IF K> 1.5* MO- 1THEN K= K- MO
7075 FOR J= KTO NO- MO/ 2- 1STEP MO
7100 S((J- K)/ MO)= D(J,1)/ D(J,2)
7125 CT= CT+ 1
7150 NEXT J
7200 FOR J= 0TO CT- 2
7225 IF S(J)< = S(J+ 1)THEN 7300
7250 Z= S(J):S(J)= S(J+ 1):S(J+ 1)= Z
7275 C= C+ 1
7300 NEXT J
7325 IF C> 0THEN C= 0:GOTO 7200
7350 Z= INT (CT/ 2)
7375 IF CT> 2* ZTHEN MD(I)= S(Z):GOTO 7425
7400 MD(I)= (S(Z- 1)+ S(Z))/ 2
7425 MD= MD+ MD(I)
7450 NEXT I
7460 REM   ADJUST SEASONAL INDICES
7475 MD= MO/ MD
7500 FOR I= 0TO MO- 1
7525 MD(I)= MD(I)* MD
7550 NEXT I
7551 PLOT 12,14,6,1
7552 PRINT "INDICES ARE"
7553 PRINT :PLOT 15,6,3
7554 FOR I= 0TO MO- 1
7556 PRINT "#"I+ 1;TAB( 10);MD(I)
7558 NEXT
7560 PLOT 3,0,31,6,1
7562 INPUT "PRESS 'RETURN' TO RETURN: ";Z$
7565 REM  ADJUST DATA
7600 FOR I= 0TO NO- 1
7625 K= I- MO* INT (I/ MO)
7650 D(I,2)= D(I,1)/ MD(K)
7675 NEXT I
7700 GOTO 1000
7999 REM
8000 REM   COMPUTE TREND
8010 PLOT 12,14,6,1
8025 PRINT "SELECT NUMBER OF REGRESSION EQUATION:"
8050 PLOT 6,3
8075 PRINT "1) LINEAR      Y=AX+B
8100 PRINT "2) LOGARITHMIC Y=LOG(AX+B)
8125 PRINT "3) EXPONENTIAL Y=EXP(AX+B)
8150 PRINT "4) RECIPROCAL  Y=1/(AX+B)
8175 INPUT Z
8200 IF Z= 1THEN DEF FN A(X)= X:DEF FN B(X)= SL* X+ IN
8225 IF Z= 2THEN DEF FN A(X)= EXP (X):DEF FN B(X)= LOG (SL* X+ IN)
8250 IF Z= 3THEN DEF FN A(X)= LOG (X):DEF FN B(X)= EXP (SL* X+ IN)
8275 IF Z= 4THEN DEF FN A(X)= 1/ X:DEF FN B(X)= 1/ (SL* X+ IN)
8280 SM(2)= 0:SS= 0
8300 FOR I= 0TO NO- 1
8325 IF Z= 2AND D(I,1)> 87THEN D(I,1)= 87
8330 IF Z= 3AND D(I,1)< = 0THEN D(I,1)= 1E- 10
8350 D(I,2)= FN A(D(I,1))
8360 SM(2)= SM(2)+ D(I,2)
8370 SS= SS+ I* D(I,2)
8375 NEXT
8425 SM(0)= NO* (NO- 1)/ 2:SQ(0)= SM(0)* (NO+ NO- 1)/ 3
8500 X= NO* SQ(0)- SM(0)* SM(0)
8525 SL= (NO* SS- SM(0)* SM(2))/ X
8550 IN= (SQ(0)* SM(2)- SM(0)* SS)/ X
8575 FOR I= 0TO NO- 1
8580 IF Z= 2AND SL* I+ IN< = 0THEN D(I,2)= - 1E10:GOTO 8625
8585 IF Z= 3AND SL* I+ IN> 87THEN D(I,2)= 1E10:GOTO 8625
8600 D(I,2)= FN B(I)
8625 NEXT
8650 PLOT 12,14,6,1
8675 PRINT "THE COEFFICIENTS ARE"
8680 PLOT 6,3
8690 PRINT "A ="SL" AND B ="IN
8700 PLOT 15,3,0,31,6,1
8750 INPUT "PRESS 'RETURN' TO CONTINUE ";Z$
8775 PLOT 6,2
8800 GOTO 1000
9999 REM
10000 REM   DRAW GRAPH
10010 PLOT 12,14
10022 IF FL> 0THEN 10175
10023 FL= 1
10025 INPUT "GRAPH NAME: ";G$
10050 INPUT "TIME-SCALE NAME, DEPENDENT-SCALE NAME: ";X$,Y$
10075 PLOT 6,6
10100 PRINT
10125 INPUT "TIME-SCALE (START, END, DIFFERENCE): ";XS,XE,XD
10150 INPUT "DEPENDENT SCALE (START, END, DIFFERENCE): ";YS,YE,YD
10175 PLOT 15,12,6,4
10200 XN= INT ((XE- XS)/ XD)+ 1:IF XN> 8THEN XN= 8
10225 YN= INT ((YE- YS)/ YD)+ 1:IF YN> 14THEN YN= 14
10250 XI= INT (49/ (XN- 1))
10275 YI= INT (26/ (YN- 1))
10300 IF XI< 7THEN XI= 7
10325 IF YI< 1THEN YI= 1
10350 FOR I= 0TO XN- 1
10375 PLOT 2,2* (9+ I* XI),14,255
10400 NEXT
10425 FOR I= 0TO YN- 1
10450 PLOT 2,16,16+ 4* I* YI,255
10475 NEXT
10500 PLOT 6,3
10525 FOR I= 0TO XN- 1
10550 PLOT 3,8+ I* XI,29:PRINT XS+ I* XD
10575 NEXT
10600 FOR I= 0TO YN- 1
10625 LY= LEN (STR$ (YS+ I* YD))
10650 PLOT 3,7- LY,27- I* YI:PRINT YS+ I* YD
10675 NEXT
10680 PLOT 6,4
10700 I= 2* (10+ XI* (XN- 1))
10725 J= 17+ 4* YI* (YN- 1)
10750 PLOT 2,17,15,242,I,15,I,J,17,J,17,15,255
10800 PLOT 6,6
10825 PLOT 3,INT ((64- LEN (G$))/ 2),0:PRINT G$
10850 PLOT 27,10
10875 PLOT 3,0,2+ INT ((26- LEN (Y$))/ 2):PRINT Y$
10900 PLOT 27,24
10925 PLOT 3,7+ INT ((56- LEN (X$))/ 2),30:PRINT X$
10950 PLOT 6,2
10999 REM
11000 REM   PLOT DATA POINTS
11005 FOR J= 0TO 1
11007 PLOT 6,1:IF J= 1THEN PLOT 6,3
11010 D= D(0,J+ 1)
11015 GOSUB 13000
11020 PLOT 2,18,16+ 4* YI* (D- YS)/ YD,242
11025 FOR I= 0TO NO- 1
11050 IF I/ TP> XS+ (XN- 1)* XDTHEN 11200
11075 D= D(I,J+ 1)
11080 GOSUB 13000
11150 PLOT 18+ 2* XI* (I/ TP- XS)/ XD,16+ 4* YI* (D- YS)/ YD
11175 NEXT
11200 PLOT 255
11210 NEXT J
11230 PLOT 6,1,3,0,31
11250 INPUT "PRESS 'RETURN' TO CONTINUE, 1-NEW SCALES OR 2-SAVE: ";Z$
11260 PLOT 6,2
11275 IF Z$= "1"THEN PLOT 12:GOTO 10125
11300 IF Z$= "2"THEN PLOT 27,4:PRINT "SAV TIMSER.DSP 6000-6FFF":PLOT 27,27
11325 PLOT 6,2
11350 GOTO 1000
11999 REM
12000 REM   COMPUTE FOURIER COEFFICIENTS
12005 PLOT 12,14
12020 INPUT "MAXIMUM ORDER OF HARMONICS? ";MX
12025 FOR I= 0TO NO- 1
12050 A0= A0+ D(I,1)
12075 NEXT
12100 A0= A0/ NO
12125 P2= 6.28318
12150 FOR I= 1TO MX
12175 K= P2* I/ NO
12200 FOR J= 0TO NO- 1
12225 A(I)= A(I)+ D(J,1)* COS (K* J)
12250 B(I)= B(I)+ D(J,1)* SIN (K* J)
12275 NEXT
12300 A(I)= 2* A(I)/ NO
12325 B(I)= 2* B(I)/ NO
12350 NEXT
12375 FOR V= 0TO NO
12400 D(V,2)= A0
12425 K= P2* V/ NO
12450 FOR J= 1TO MX
12475 D(V,2)= D(V,2)+ A(J)* COS (K* J)+ B(J)* SIN (K* J)
12500 NEXT
12525 NEXT
12530 PLOT 14,12,6,1
12550 PRINT "THE FOURIER COEFFICIENTS ARE"
12560 PRINT
12565 PLOT 6,3
12575 PRINT "A(0) ="A0
12600 FOR I= 1TO MX
12625 X$= MID$ (STR$ (I),2)
12650 PRINT "A("X$") =";A(I);TAB( 20);"B("X$") =";B(I)
12675 NEXT
12725 PLOT 15,3,0,31,6,1
12750 INPUT "PRESS 'RETURN' WHEN READY ";Z$
12775 PLOT 6,2
12800 GOTO 1000
13000 REM   CHECK VALUE OF DEPENDENT VARIABLE
13025 IF D< YSTHEN D= YS:RETURN
13050 Z= YS+ YD* (YN- 1)
13075 IF D> ZTHEN D= Z
13100 RETURN
13999 REM
14000 REM   COMPUTE A FOURIER VALUE
14025 F= A0
14050 K= P2* V/ NO
14075 FOR J= 1TO MX
14100 F= F+ A(J)* COS (K* J)+ B(J)* SIN (K* J)
14125 NEXT
14150 RETURN
14999 REM
15000 REM  DISPLAY DATA
15025 PLOT 6,1
15050 INPUT "BEG. DATA ITEM # (OR '0' TO RETURN): ";B
15060 PLOT 12
15075 IF B< 1THEN 1000
15100 IF NO< BTHEN B= NO
15125 E= B+ 29:IF NO< ETHEN E= NO
15150 PLOT 12
15175 FOR I= BTO E
15200 PLOT 6,1
15225 PRINT "#"I;
15250 PLOT 6,3
15275 PRINT TAB( 6);D(I- 1,1);TAB( 16);D(I- 1,2)
15300 NEXT
15325 PLOT 3,0,31
15350 GOTO 15025
15999 REM
16000 REM   COMPUTE AND DISPLAY STATISTICS
16025 FOR I= 0TO NO- 1
16050 FOR J= 1TO 2
16075 SM(J)= SM(J)+ D(I,J)
16100 SQ(J)= SQ(J)+ D(I,J)* D(I,J)
16125 IF I= 0THEN MN(J)= D(I,J):MX(J)= D(I,J)
16150 IF D(I,J)< MN(J)THEN MN(J)= D(I,J)
16175 IF D(I,J)> MX(J)THEN MX(J)= D(I,J)
16200 NEXT
16225 SS= SS+ D(I,1)* D(I,2)
16250 NEXT
16275 FOR I= 1TO 2
16300 R(I)= MX(I)- MN(I)
16325 M(I)= SM(I)/ NO
16350 V(I)= (NO* SQ(I)- SM(I)* SM(I))/ (NO* (NO- 1))
16375 SD(I)= SQR (ABS (V(I)))
16400 SE(I)= SD(I)/ SQR (NO)
16425 NEXT
16450 PLOT 12,14,6,1
16500 PRINT SPC( 21)"MONOVARIATE ANALYSIS"
16525 PRINT :PLOT 6,2
16550 PRINT "NUMBER OF DATA POINtS: "NO
16575 PRINT :PLOT 6,3
16625 PRINT "STANDARD DEVIATION:  "SD(1);TAB( 37);SD(2)
16650 PRINT "RANGE:               "R(1);TAB( 37);R(2)
16660 PRINT "ARITHMETIC MEAN:     "M(1);TAB( 37);M(2)
16675 PRINT "STANDARD ERROR:      "SE(1);TAB( 37);SE(2)
16700 PRINT "MINIMUM VALUE:       "MN(1);TAB( 37);MN(2)
16725 PRINT "MAXIMUM VALUE:       "MX(1);TAB( 37);MX(2)
16750 PRINT "TOTAL SUM:           "SM(1);TAB( 37);SM(2)
16775 PRINT "SUM OF SQUARES:      "SQ(1);TAB( 37);SQ(2)
16800 PRINT
16825 PLOT 15,3,0,31,6,1
16850 INPUT "PRESS 'RETURN' WHEN READY ";Z$
16875 PLOT 6,2,12
16900 GOTO 1000
20000 REM   END PROGRAM
20025 LOAD "MENU":RUN