Compucolor.org – Virtual Media

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

5 REM   MLTREG
6 REM   LINEAR MULTIPLE REGRESSION
7 REM  WRITTEN BY WALTER DEGLER  3,20,79
10 REM
15 REM  LINEAR REGRESSION ON UP TO 6 VARIABLES WITH TRANSFORMS
20 REM
22 CLEAR 150
24 DIM D(199,5)
25 PLOT 12,14,27,24,6,2
45 FOR I= 0TO 5
50 X(I)= .0001
55 ON I+ 1GOSUB 999,1005,1015,1025,1035,1045
60 IF X(I)< > .0001THEN 2000
65 NEXT
75 INPUT "ARE TRANSFORMS TO BE USED? ";Z$:Z$= LEFT$ (Z$,1)
80 PLOT 12
100 IF Z$= "Y"THEN PLOT 15:GOTO 800
125 GOTO 2000
800 PRINT "ENTER FUNCTIONS FOR THE TRANSFORMS IN 'BASIC' FORMAT"
802 PRINT "USING LINE NUMBERS FROM 1000 IN INCREMENTS OF 10"
804 PRINT "AND V(0)(DEPENDENT VARIABLE), V(1), V(2),...FOR THE"
805 PRINT "RESPECTIVE INPUT VARIABLES. USE X(0) (DEPENDENT VARIABLE),"
806 PRINT "X(1), X(2),...FOR THE RESPECTIVE TRANSFORMED VARIABLES."
808 PRINT "FOLLOW THIS BY THE STATEMENT 'RUN'."
809 PLOT 6,1
810 PRINT :PRINT "EXAMPLE:"
811 PLOT 6,3
812 PRINT "1000 X(0) = V(0)
814 PRINT "1010 X(1) = 3 * V(1) + V(3) - V(4)
816 PRINT "1020 X(2) = V(2) - V(5)
818 PRINT "1030 X(3) = V(3)
820 PRINT "1040 X(4) = V(5)
822 PRINT "1050 X(5) = V(5) - 2
824 PRINT "RUN"
826 PRINT
827 PLOT 6,2
828 PRINT "NOTE: IDENTITY FN. USED FOR X(3) WHERE NO TRANSFORM WAS NEEDED"
830 PRINT
832 END
999 REM  FORMULAS FOR TRANSFORMS FOLLOW:
1005 RETURN
1015 RETURN
1025 RETURN
1035 RETURN
1045 RETURN
1055 RETURN
1990 END
1999 REM
2000 REM  INPUT DATA
2030 INPUT "DATA SOURCE (F-FILE OR K-KEYBOARD): ";Z$
2035 INPUT "NUMBER OF VARIABLES: ";V
2050 IF Z$< > "F"THEN 2500
2125 INPUT "FILE NAME: ";F$
2150 FOR I= 0TO V- 1
2175 PRINT "TYPE #";I+ 1;" ";:INPUT TP(I)
2200 NEXT
2225 FILE "R",1,F$,6
2250 GET 1,1,5;NO
2300 FOR I= 0TO NO- 1
2325 FOR J= 0TO V- 1
2350 GET 1,TP(J),4* I+ 9;D(I,J)
2375 NEXT J,I
2400 FILE "C",1
2425 DF= NO- V
2450 GOTO 2825
2500 PLOT 12
2525 INPUT "NUMBER OF OBSERVATIONS: ";NO
2575 PLOT 12,15,27,11,6,1
2600 PRINT :PRINT "OBSERVATION #, DEPENDENT VALUE, INDEPENDENT VALUES:"
2610 PRINT
2625 PLOT 6,3
2650 INPUT "#";I
2675 IF I< 1THEN PLOT 14,27,24:GOTO 2425
2700 FOR J= 0TO V- 1
2725 PRINT SPC( 6+ 10* J);:PLOT 28
2750 INPUT "";D(I- 1,J)
2775 NEXT
2800 GOTO 2650
2825 IF Z$= "N"THEN 3000
2850 FOR I= 0TO NO- 1:FOR J= 1TO V- 1
2875 X(J)= D(I,J- 1)
2900 NEXT
2925 ON JGOSUB 1000,1010,1020,1030,1040
2950 NEXT J,I
2999 REM
3000 REM  COMPUTE SUMS
3010 IF Z$= "Y"THEN GOSUB 15000
3025 FOR I= 0TO V- 1
3050 FOR J= 0TO NO- 1
3075 SM(I)= SM(I)+ D(J,I)
3100 NEXT J
3125 MN(I)= SM(I)/ NO
3130 S2$(I)= "-":IF MN(I)< 0THEN S2$(I)= "+"
3150 NEXT I
3200 FOR I= 1TO V- 1
3225 FOR J= ITO V- 1
3230 C(I- 1,J- 1)= 0
3250 FOR K= 0TO NO- 1
3275 C(I- 1,J- 1)= C(I- 1,J- 1)+ (D(K,I)- MN(I))* (D(K,J)- MN(J))
3300 C(J- 1,I- 1)= C(I- 1,J- 1)
3325 NEXT K,J,I
3400 FOR I= 1TO V- 1
3405 M1(I)= 0
3425 FOR J= 0TO NO- 1
3450 M1(I)= M1(I)+ D(J,0)* (D(J,I)- MN(I))
3460 C(I- 1,V- 1)= C(I- 1,V- 1)+ (D(J,0)- MN(0))* (D(J,I)- MN(I))
3475 NEXT J,I
3480 YM= 0
3500 FOR I= 0TO NO- 1
3525 Z= D(I,0)- MN(0)
3550 YM= YM+ Z* Z
3575 NEXT
3600 FOR I= 0TO V- 2
3625 DG(I)= C(I,I)
3650 NEXT
3999 REM
4000 REM  GAUSS-JORDAN SOLUTION FOR COEFFICIENTS
4005 REM
4010 REM  FIND MAX ABS VALUE IN COL FOR PIVOT
4025 FOR I= 0TO V- 2
4050 MX= 0
4075 FOR J= 0TO V- 2
4100 IF MX> = ABS (C(J,I))THEN 4200
4125 IF CK(J)> 0THEN 4200
4150 LC(I)= J
4175 MX= ABS (C(J,I))
4200 NEXT J
4225 IF ABS (MX)> = 1E- 5THEN 4250
4230 PRINT "MATRIX SINGULAR":PRINT "CHANGE DATA"
4235 FOR K= 0TO 500:NEXT K
4240 GOTO 25
4250 L= LC(I):CK(L)= 1
4255 REM  SET UNIT VECTOR IN LAST COLUMN
4260 FOR K= 0TO V- 2:C(K,V)= 0:NEXT
4265 C(L,V)= 1
4275 REM  NORMALIZE PIVOT ROW
4280 FC= C(L,I)
4285 FOR K= 0TO V:C(L,K)= C(L,K)/ FC:NEXT
4295 REM  TRANSFORM NON-PIVOT ROWS
4300 FOR K= 0TO V- 2
4325 IF K= LTHEN 4450
4350 FC= C(K,I)
4375 FOR J= 0TO V
4400 C(K,J)= C(K,J)- FC* C(L,J)
4425 NEXT J
4450 NEXT K
4455 REM  COPY UNIT VECTOR COLUMN IN PIVOT COLUMN
4460 FOR K= 0TO V- 2:C(K,I)= C(K,V):NEXT
4475 NEXT I
4480 REM  SET COEFFICIENT VALUES
4500 FOR I= 0TO V- 2
4525 L= LC(I)
4550 A(I+ 1)= C(L,V- 1)
4560 S1$(I+ 1)= "+":IF A(I+ 1)< 0THEN S1$(I+ 1)= "-"
4575 NEXT
4600 A(0)= MN(0)
4625 GOTO 8000
5999 REM
6000 REM   COMPUTE A VALUE OF Y FOR GIVEN X(I)
6025 Y= A(0)
6050 FOR K= 1TO V- 1
6075 Y= Y+ A(K)* (X(K)- MN(K))
6100 NEXT
6125 X= ABS (Y)
6150 IF X< 1E- 5THEN C$= "0":RETURN
6175 IF X< .01THEN X= Y:GOSUB 16000:RETURN
6200 C$= STR$ (Y)
6225 RETURN
7999 REM
8000 REM  COMPUTE OTHER STATISTICS
8010 DF= NO- V
8125 FOR I= 1TO V- 1
8150 R2= R2+ A(I)* M1(I)
8175 NEXT
8200 S2= (YM- R2)/ DF
8210 IF YM= 0THEN R2= 999999:GOTO 8250
8225 R2= R2/ YM
8250 FOR I= 1TO V- 1
8275 CO(I)= M1(I)/ SQR (ABS (YM* DG(I- 1)))
8300 SD(I)= SQR (ABS (DG(I- 1)/ (NO- 1)))
8325 SE(I)= SQR (ABS (S2* C(LC(I- 1),LC(I- 1))))
8350 NEXT
8360 Z= SQR (ABS (S2))
8375 FOR I= 1TO V- 1
8380 IF SE(I)= 0THEN TV(I)= 999999:GOTO 8425
8400 TV(I)= A(I)/ SE(I)
8425 NEXT
8450 DF(0)= V- 1:DF(1)= NO- DF(0)- 1
8475 SS(0)= R2* YM:SS(1)= YM- SS(0)
8500 MS(0)= SS(0)/ DF(0):MS(1)= SS(1)/ DF(1)
8510 IF MS(1)= 0THEN F= 999999:GOTO 13000
8525 F= MS(0)/ MS(1)
8550 GOTO 13000
11999 REM
12000 REM  DISPLAY HEADINGS AND LABELS
12025 PLOT 14,3,0,0,6,6
12050 PRINT SPC( 18);"MULTIPLE CORRELATION ANALYSIS"
12075 PLOT 6,1,15
12100 PRINT "VAR   SUM     MEAN    ST DEV   X/Y CORR   ";
12125 PRINT "COMPUTED T  COEF ERR"
12127 PLOT 10,6,2
12130 PRINT "Y"
12135 FOR I= 1TO V- 1:PRINT "X";I;:PLOT 26,26:PRINT "(";:PLOT 25:PRINT ")"
12140 NEXT
12150 PLOT 3,0,13
12175 PRINT "EQUATION:";TAB( 32);"MULTIPLE CORR."
12200 PLOT 3,32,14:PRINT "ST ERROR OF EST."
12225 PLOT 3,23,23,6,6,14
12250 PRINT "ANALYSIS OF VARIANCE"
12275 PLOT 6,1,15
12300 PRINT TAB( 11);"DEG FREEDOM  SUM OF SQUARES  MEAN SQUARES    F"
12310 PRINT :PLOT 6,2
12325 PRINT "EXPLAINED":PRINT "UNEXPLAINED"
12350 PRINT :PRINT "    TOTAL"
12375 PLOT 15,3,0,31,6,1
12400 INPUT "ENTER 1-RESIDUALS, 2-SAVE OR 3-END: ";X
12405 IF X= 1THEN PLOT 12:GOTO 14000
12425 IF X< > 2THEN LOAD "MENU":RUN
12450 PLOT 27,4:PRINT "SAV REG.DSP 6000 1000":PLOT 27,27
12475 PLOT 12:INPUT "1-RESIDUALS OR 2-END: ";X
12480 PLOT 12
12500 IF X= 1THEN 14000
12525 LOAD "MENU":RUN
13000 REM  DISPLAY VALUES
13025 PLOT 12,15,3,0,5,6,3
13030 PRINT TAB( 4);SM(0);TAB( 12);MN(0);TAB( 20);SQR (YM/ (NO- 1))
13050 FOR I= 1TO V- 1
13060 PRINT TAB( 4);SM(I);TAB( 12);MN(I);TAB( 20);SD(I);TAB( 30);
13065 IF ABS (CO(I))> = .01THEN PRINT CO(I);:GOTO 13075
13070 X= CO(I):GOSUB 16000:PRINT C$;
13075 PRINT TAB( 40);
13080 IF ABS (TV(I))> = .01THEN PRINT TV(I);:GOTO 13090
13085 X= TV(I):GOSUB 16000:PRINT C$;
13090 PRINT TAB( 52);
13095 IF ABS (SE(I))> = .01THEN PRINT SE(I):GOTO 13105
13100 X= SE(I):GOSUB 16000:PRINT C$
13105 NEXT
13150 PLOT 3,49,13:PRINT SQR (ABS (R2))
13155 S$= " ":IF A(0)< 0THEN S$= "-"
13157 PRINT "Y=";
13160 X= ABS (A(0))
13165 IF X< 1E- 5THEN 13180
13170 C$= STR$ (X):IF X< .01THEN GOSUB 16000
13175 PRINT S$,C$
13180 PLOT 3,49,14:PRINT SQR (ABS (S2))
13200 FOR I= 1TO V- 1
13210 X= ABS (A(I))
13215 IF X< 1E- 5THEN 13250
13220 C$= STR$ (X):IF X< .01THEN GOSUB 16000
13225 PRINT "  ";S1$(I);C$;"(X";I;
13227 PLOT 26,26:PRINT "(";:PLOT 25
13228 X= ABS (MN(I))
13229 IF X< 1E- 5THEN PRINT ")":GOTO 13250
13230 C$= STR$ (X):IF X< .01THEN GOSUB 16000
13240 PRINT ")";S2$(I);C$;")"
13250 NEXT I
13300 FOR I= 0TO 1
13325 PLOT 3,0,27+ I
13350 PRINT TAB( 14);DF(I);TAB( 26);SS(I);TAB( 41);MS(I)
13375 NEXT
13425 PLOT 3,53,27:PRINT F
13450 PLOT 3,0,30
13475 PRINT TAB( 14);DF(0)+ DF(1);TAB( 26);SS(0)+ SS(1)
13500 GOTO 12000
13999 REM
14000 REM  DISPLAY RESIDUALS
14001 PLOT 12,6,6
14002 INPUT "BEG. OBSERVATION #: ";B
14003 IF B< 1THEN B= 1
14005 IF NO< BTHEN B= NO
14007 E= B+ 29:IF NO< ETHEN E= NO
14009 PLOT 12,6,1
14010 PRINT "#";TAB( 6);"Y-VALUE";TAB( 21);"Y-ESTIMATE";TAB( 36);"RESIDUAL"
14020 PLOT 6,3
14022 FOR I= B- 1TO E- 1
14025 FOR J= 1TO V- 1
14050 X(J)= D(I,J)
14075 NEXT
14100 GOSUB 6000
14110 X= ABS (Y- D(I,0))
14115 IF X< 1E- 5THEN D$= "0":GOTO 14125
14120 IF X< .01THEN X= Y- D(I,0):GOSUB 16000:D$= C$:GOTO 14125
14122 D$= STR$ (Y- D(I,0))
14125 PRINT I+ 1;TAB( 6);D(I,0);TAB( 21);C$;TAB( 36);D$
14150 NEXT I
14195 PLOT 3,0,31,6,1
14200 INPUT "1-CONTINUE, 2-SAVE OR 3-END: ";Z
14225 IF Z= 1THEN 14001
14250 IF Z< > 2THEN LOAD "MENU":RUN
14275 PLOT 27,4:PRINT "SAV MLTREG.DSP 6000-6FFF":PLOT 27,27
14300 GOTO 14001
14999 REM
15000 REM  COMPUTE TRANSFORMS
15025 FOR I= 0TO NO- 1
15050 FOR J= 0TO V- 1
15075 V(J)= D(I,J)
15100 NEXT
15125 FOR J= 0TO V- 1
15150 ON JGOSUB 999,1005,1015,1025,1035,1045
15175 D(I,J)= X(J)
15200 NEXT J,I
15225 RETURN
15999 REM
16000 REM  CHANGE EXPONENTIAL-FORM NUMBERS FOR DISPLAY
16025 B$= STR$ (X)
16030 C$= " .":IF X< 0THEN C$= "-."
16040 Z= VAL (RIGHT$ (B$,2))
16050 FOR K= 2TO Z
16075 C$= C$+ "0"
16080 IF LEN (C$)> 6THEN C$= "0":RETURN
16100 NEXT
16125 C$= C$+ MID$ (B$,2,1)
16130 IF LEN (B$)< 7THEN RETURN
16150 FOR K= 4TO LEN (B$)- 4
16175 C$= C$+ MID$ (B$,K,1)
16200 NEXT
16225 RETURN