Compucolor.org – Virtual Media

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

5 REM  INDEX
7 REM  WRITTEN BY WALTER DEGLER  5,10,79
25 PLOT 27,24,12,14,6,2
50 GOSUB 2000
999 REM
1000 REM  SELECT CHOICE
1010 PLOT 12,14,6,1
1025 PRINT "ENTER NUMBER OF DESIRED CHOICE:"
1030 PLOT 6,2
1050 PRINT "1 - DISPLAY INDEX NUMBERS
1075 PRINT "2 - DISPLAY DATA WITH WEIGHTS
1100 PRINT "3 - END PROGRAM
1200 INPUT Z
1210 PLOT 15
1225 ON ZGOSUB 6000,8000,1500
1250 GOTO 1000
1500 LOAD "MENU":RUN
1999 REM
2000 REM  INPUT DATA
2025 INPUT "DATA SOURCE (F-FILE OR K-KEYBOARD): ";Z$
2050 INPUT "NUMBER OF PERIODS: ";NP
2075 IF Z$= "F"THEN 2500
2100 INPUT "NUMBER OF ITEMS: ";NO
2125 PLOT 27,11,15
2150 FOR I= 1TO NP
2175 PLOT 6,1
2200 PRINT "PERIOD"I" ITEM #, SIZE, AMOUNT:"
2225 PLOT 6,3
2250 INPUT "#";J
2275 IF J< 1THEN 2425
2300 FOR K= 0TO 1
2325 PRINT SPC( 6+ 10* K);:PLOT 28
2350 INPUT "";D(I- 1,J- 1,K)
2375 NEXT
2400 GOTO 2250
2425 NEXT
2450 PLOT 27,24,14:GOTO 3000
2500 PLOT 12,15
2505 FOR I= 0TO NP- 1
2510 PLOT 6,1
2525 PRINT "PERIOD"I+ 1" FILE NAME (OR 'S' IF SAME AS LAST)"
2527 PLOT 6,3
2530 INPUT G$
2535 PLOT 6,1
2540 IF G$= "S"THEN 2575
2550 IF F$= ""THEN 2557
2555 FILE "C",1
2557 F$= G$
2560 FILE "R",1,F$,6
2575 PRINT "SIZE TYPE #, AMOUNT TYPE #"
2580 PLOT 6,3
2585 INPUT T1,T2
2600 GET 1,1,5;NO
2625 FOR J= 0TO NO- 1
2650 GET 1,T1,9+ 4* J;D(I,J,0)
2675 GET 1,T2,9+ 4* J;D(I,J,1)
2700 NEXT J,I
2725 FILE "C",1
2750 RETURN
2999 REM
3000 REM  COMPUTE WEIGHTS, IF NECESSARY
3010 PLOT 12,14,6,6
3025 INPUT "ENTER 1-WEIGHT=AMOUNT OR 2-WEIGHT=SIZE X AMOUNT: ";Z
3050 IF Z= 1GOTO 3160
3075 FOR I= 0TO NP- 1
3100 FOR J= 0TO NO- 1
3125 D(I,J,2)= D(I,J,0)* D(I,J,1)
3150 NEXT J,I
3155 GOTO 3195
3160 FOR I= 0TO NP- 1
3165 FOR J= 0TO NO- 1
3170 D(I,J,2)= D(I,J,1)
3175 NEXT J,I
3195 INPUT "NORMALIZE WEIGHTS? ";Z$
3200 IF LEFT$ (Z$,1)= "N"THEN 4000
3225 FOR I= 0TO NP- 1
3250 FOR J= 0TO NO- 1
3275 SW(I)= SW(I)+ D(I,J,2)
3300 NEXT J,I
3325 FOR I= 0TO NP- 1
3350 FOR J= 0TO NO- 1
3375 D(I,J,2)= D(I,J,2)/ SW(I)
3400 NEXT J,I
3999 REM
4000 REM  ESTABLISH BASE PERIOD
4025 INPUT "BASE PERIOD? ";B
4050 B= B- 1
4999 REM
5000 REM  COMPUTE SUMS
5025 FOR I= 0TO NO- 1
5050 SA= SA+ D(B,I,0)* D(B,I,2)
5075 SB= SB+ D(B,I,2)
5100 FOR J= 0TO NP- 1
5125 S1(J)= S1(J)+ D(B,I,0)* D(J,I,2)
5150 S2(J)= S2(J)+ D(J,I,0)* D(B,I,2)
5175 S3(J)= S3(J)+ D(J,I,0)* D(J,I,2)
5200 X= SQR (ABS (D(B,I,2)* D(J,I,2)))
5225 S4(J)= S4(J)+ D(B,I,0)* X
5250 S5(J)= S5(J)+ D(J,I,0)* X
5275 X= D(B,I,2)+ D(J,I,2)
5300 S6(J)= S6(J)+ X* D(J,I,0)/ D(B,I,0)
5325 S7(J)= S7(J)+ X
5350 S8(J)= S8(J)+ D(B,I,2)* D(B,I,0)/ D(J,I,0)
5375 S9(J)= S9(J)+ D(B,I,2)* LOG (D(J,I,0)/ D(B,I,0))
5400 IF S9(J)> 87THEN S9(J)= 87
5425 NEXT J,I
5450 RETURN
5999 REM
6000 REM  COMPUTE INDEX NUMBERS
6010 GOSUB 3000
6025 FOR I= 0TO NP- 1
6050 LN(I)= S2(I)/ SA
6075 PN(I)= S3(I)/ S1(I)
6100 EN(I)= S6(I)/ S7(I)
6125 WN(I)= S5(I)/ S4(I)
6150 BN(I)= .5* (LN(I)+ PN(I))
6175 IN(I)= SQR (ABS (LN(I)* PN(I)))
6200 GN(I)= 1
6225 GN(I)= EXP (S9(I))
6300 HN(I)= SB/ S8(I)
6325 NEXT
6999 REM
7000 REM  DISPLAY INDEX NUMBERS
7025 PLOT 12,15,6,2
7050 PRINT SPC( 25);"INDEX NUMBERS"
7075 PRINT
7100 PLOT 6,1
7125 PRINT TAB( 5);"LASPEYRE";TAB( 18);"PAASCHE    MARSHALL/EDGEWORTH  WALSH"
7150 PRINT TAB( 6);"BOWLEY";TAB( 16);"FISHER-IDEAL";TAB( 33);"GEOMETRIC";TAB( 47);"HARMONIC"
7175 FOR I= 0TO NP- 1
7180 IF I= BTHEN 7275
7200 PLOT 6,2
7210 PRINT I+ 1;
7220 PLOT 6,3
7225 PRINT TAB( 5);LN(I);TAB( 19);PN(I);TAB( 33);EN(I);TAB( 47);WN(I)
7250 PRINT TAB( 5);BN(I);TAB( 19);IN(I);TAB( 33);GN(I);TAB( 47);HN(I)
7260 PRINT
7275 NEXT
7350 PLOT 3,0,31
7375 PLOT 6,1
7400 INPUT "ENTER 1-RETURN OR 2-SAVE, THEN RETURN: ";Z
7425 IF Z< > 2THEN RETURN
7475 PLOT 27,4:PRINT "SAV INDEX.DSP 6000 1000":PLOT 27,27
7500 RETURN
7999 REM
8000 REM  DISPLAY DATA AND WEIGHTS
8005 GOSUB 3000
8010 PLOT 6,6
8025 INPUT "PERIOD TO DISPLAY: ";J
8030 J= J- 1
8050 PLOT 12,15,6,2
8060 PRINT TAB( 11);"COMPARISON OF BASE PERIOD TO CURRENT PERIOD"
8065 PRINT :PLOT 6,1
8075 PRINT "ITEM BASE SZ  BASE AMT BASE WT     CURR SZ  CURR AMT CURR WT"
8100 FOR I= 0TO NO- 1
8110 PLOT 6,3
8125 PRINT I+ 1;TAB( 4);D(B,I,0);TAB( 13);D(B,I,1);TAB( 22);D(B,I,2);
8130 PLOT 6,6
8150 PRINT TAB( 34);D(J,I,0);TAB( 43);D(J,I,1);TAB( 52);D(J,I,2)
8175 NEXT
8200 GOTO 7350