Compucolor.org – Virtual Media

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

5 PRINT "NTH ORDER REGRESSION ADAPTED FOR COMPUCOLOR BY "
7 PRINT "R.S.SHEVELL":PRINT :
9 PRINT "SET LIMITS ON DEGREE OF EQUATION BY TYPING (1)'BREAK'"
11 PRINT "(2)' 41 DIM A(2D+1),R(D+1,D+2),T(D+2) ' WHERE D=MAX-"
13 PRINT "IMUM DEGREE OF EQUATION. ENTER THIS AND TYPE'GOTO 20'."
16 PRINT :PRINT
18 INPUT GA
20 PRINT
25 DIM XP(22),YP(22)
30 REM -SET LIMITS ON DEGREE OF EQUATION TO A(2D+1),R(D+1,D+2),
40 REM  T(D+2)(WHERE D=MAXIMUM DEGREE OF EQUATION)
41 DIM A(9),R(5,6),T(6)
44 PRINT
45 PRINT "DEGREE OF EQUATION"
50 INPUT D
60 PRINT "NUMBER OF KNOWN POINTS"
70 INPUT N
75 DIM X(N),Y(N)
80 A(1)= N
89 REM -ENTER COORDINATES OF DATA POINTS
90 FOR I= 1TO N
100 PRINT "X,Y OF POINT ";I
110 INPUT X,Y
115 X(I)= X:Y(I)= Y
118 REM -LINES 120 TO 200 POPULATE MATRICES WITH A
119 REM - SYSTEM OF EQUATIONS
120 FOR J= 2TO 2* D+ 1
130 A(J)= A(J)+ X^ (J- 1)
140 NEXT J
150 FOR K= 1TO D+ 1
160 R(K,D+ 2)= T(K)+ Y* X^ (K- 1)
170 T(K)= T(K)+ Y* X^ (K- 1)
180 NEXT K
190 T(D+ 2)= T(D+ 2)+ Y^ 2
200 NEXT I
209 REM -LINES 210 TO 490 SOLVE THE SYSTEM OF EQUATIONS
210 REM -IN THE MATRICES
215 FOR J= 1TO D+ 1
220 FOR K= 1TO D+ 1
230 R(J,K)= A(J+ K- 1)
240 NEXT K
250 NEXT J
260 FOR J= 1TO D+ 1
270 FOR K= JTO D+ 1
280 IF R(K,J)< > 0THEN 320
290 NEXT K
300 PRINT "NO UNIQUE SOLUTION"
310 GOTO 790
320 FOR I= 1TO D+ 2
330 S= R(J,I)
340 R(J,I)= R(K,I)
350 R(K,I)= S
360 NEXT I
370 Z= 1/ R(J,J)
380 FOR I= 1TO D+ 2
390 R(J,I)= Z* R(J,I)
400 NEXT I
410 FOR K= 1TO D+ 1
420 IF K= JTHEN 470
430 Z= - R(K,J)
440 FOR I= 1TO D+ 2
450 R(K,I)= R(K,I)+ Z* R(J,I)
460 NEXT I
470 NEXT K
480 NEXT J
490 PRINT
495 PRINT "             CONSTANT =";R(1,D+ 2)
499 REM -PRINT  EQUATION COEFFICIENTS
500 FOR J= 1TO D
510 PRINT J;"DEGREE COEFFICIENT =";R(J+ 1,D+ 2)
520 NEXT J
530 PRINT
532 IF ZZ> < 2THEN 539
535 IF ZZ= 2THEN PRINT "TYPE 'GO' WHEN FINISHED"
536 INPUT S$
537 IF S$= "GO"THEN 5100
539 REM -COMPUTE REGRESSION ANALYSIS
540 P= 0
550 FOR J= 2TO D+ 1
560 P= P+ R(J,D+ 2)* (T(J)- A(J)* T(1)/ N)
570 NEXT J
580 Q= T(D+ 2)- T(1)^ 2/ N
590 Z= Q- P
600 I= N- D- 1
620 PRINT
630 J= P/ Q
640 PRINT "COEFFICIENT OF DETERMINATION(R^2)=";J
650 PRINT "COEFFICIENT OF CORRELATION =";SQR (J)
660 PRINT "STANDARD ERROR OF ESTIMATE =";SQR (Z/ I)
670 PRINT
679 REM -COMPUTE Y-COORDINATE FROM ENTERED X-COORDINATE
680 PRINT "INTERPOLATION:(ENTER 0 TO END POINT INTERPOLATION)"
690 P= R(1,D+ 2)
695 PRINT
700 PRINT "X =";
710 INPUT X
720 IF X= 0THEN 790
730 FOR J= 1TO D
740 P= P+ R(J+ 1,D+ 2)* X^ J
750 NEXT J
760 PRINT "Y =";P
770 PRINT
780 GOTO 690
790 PRINT "DO YOU WANT TO;"
795 PRINT :PRINT "(1) END THE PROGRAM"
800 PRINT :PRINT "(2)PLOT THE CALCULATED CURVE AND THE INPUT POINTS"
805 PRINT :PRINT "ENTER THE APPROPRIATE NUMBER"
810 PRINT :INPUT FF
815 IF FF= 1THEN 5000
820 IF FF= 2THEN 1000
1000 REM -COMPUTE AND PLOT THE DERIVED CURVE AND THE ORIGINAL             INPUT DATA.
1020 REM - LET XL BE THE LARGEST VALUE OF X INPUT ORIGINALLY AND          XS IS THE SMALLEST X .
1040 XL= X(1)
1060 FOR I= 1TO N
1080 IF X(I)> XLTHEN XL= X(I)
1100 NEXT I
1120 XS= X(1)
1140 FOR I= 1TO N
1160 IF X(I)< XSTHEN XS= X(I)
1180 NEXT I
1200 REM -DIVIDE THE 'X' RANGE INTO 20 SEGMENTS WHOSE SIZE IS DV
1220 DX= (XL- XS)/ 20
1260 REM -FIND X-COORDINATE OF THE Y AXIS
1270 IF XS> 0THEN XY= 10:GOTO 1320
1280 IF XS< 0AND XL> 0THEN 1290
1285 IF XL< 0THEN 1310
1290 XY= (ABS (XS)/ (ABS (XS)+ ABS (XL)))* 128:GOTO 1320
1300 IF XL< 0THEN 1310
1310 XY= 127:GOTO 1320
1320 IF XY< 10THEN XY= 10
1330 REM -FIND THE LARGEST AND THE SMALLEST INPUT 'Y'VALUES,YL        AND YS
1360 YL= Y(1)
1380 FOR I= 1TO N
1400 IF Y(I)> YLTHEN YL= Y(I)
1420 NEXT I
1440 YS= Y(1)
1460 FOR I= 1TO N
1480 IF Y(I)< YSTHEN YS= Y(I)
1500 NEXT I
1520 REM -FIND THE Y-COORDINATE OF THE X-AXIS
1530 IF YS> 0THEN YX= 10:GOTO 1570
1535 IF YS< 0AND YL> 0THEN 1540
1537 IF YL< 0THEN 1560
1540 YX= (ABS (YS)/ (ABS (YS)+ ABS (YL)))* 128:GOTO 1570
1560 YX= 127:GOTO 1573
1570 IF YX< 10THEN YX= 10
1573 PLOT 12
1575 PLOT 29:PLOT 23
1580 REM - DRAW AXES
1600 PLOT 2,0,YX,242,127,YX,255
1620 PLOT 2,XY,0,242,XY,127,255
1640 FOR I= 1TO 22
1680 P= R(1,D+ 2)
1720 X= XS+ (DX* (I- 1))
1740 FOR J= 1TO D
1760 P= P+ R(J+ 1,D+ 2)* X^ J
1780 NEXT J
1800 Y= P
1820 REM -XP AND YP ARE THE PLOTTED VALUES OF THE ABSCISSA AND        ORDINATE POINTS.
1822 IF XS> 0THEN 1835
1826 IF XS< 0AND XL> 0THEN 1840
1828 IF XL< 0THEN 1843
1835 XP= 10+ ((X/ XL)* 118* .9):GOTO 1845
1840 XP= XY+ ((X/ (XL- XS))* 128* .9):GOTO 1845
1843 XP= XY+ ((X/ ABS (XS))* 128* .9):GOTO 1845
1845 XP(I)= XP
1850 IF YS> 0THEN 1857
1852 IF YS< 0AND YL> 0THEN 1860
1854 IF YL< 0THEN 1863
1857 YP= 10+ ((Y/ YL)* 118* .9):GOTO 1865
1860 YP= YX+ ((Y/ (YL- YS))* 128* .9):GOTO 1865
1863 YP= YX+ ((Y/ ABS (YS))* 128* .9):GOTO 1865
1865 YP(I)= YP
1868 NEXT I
1870 PLOT 29:PLOT 17
1875 I= 1
1877 GOTO 1880
1880 IF YP(I)< 0OR YP(I)> 127THEN I= I+ 1:GOTO 1877
1885 IF XP(I)< 0OR XP(I)> 127THEN I= I+ 1:GOTO 1877
1900 PLOT 2,XP(I),YP(I)
1920 PLOT 242
1930 FOR I= ITO 22
1935 IF YP(I)> 127OR YP(I)< 0THEN 1960
1937 IF XP(I)> 127OR XP(I)< 0THEN 1960
1940 PLOT XP(I),YP(I)
1960 NEXT I
1980 PLOT 255
2500 FOR I= 1TO N
2510 REM -XT AND YT ARE THE PLOTTED VALUES OF THE INPUT POINTS
2520 IF XS> 0THEN 2540
2525 IF XS< 0AND XL> 0THEN 2580
2530 IF XL< 0THEN 2590
2540 XT= 10+ ((X(I)/ XL)* 118* .9)
2545 GOTO 2600
2580 XT= XY+ ((X(I)/ (XL- XS))* 128* .9)
2585 GOTO 2600
2590 XT= XY+ ((X(I)/ ABS (XS))* 128* .9)
2595 GOTO 2600
2600 IF YS> 0THEN 2620
2605 IF YS< 0AND YL> 0THEN 2660
2610 IF YL< 0THEN 2670
2620 YT= 10+ ((Y(I)/ YL)* 118* .9)
2640 GOTO 2680
2660 YT= YX+ ((Y(I)/ (YL- YS))* 128* .9)
2665 GOTO 2680
2670 YT= YX+ ((Y(I)/ ABS (YS))* 128* .9)
2680 PLOT 29:PLOT 19
2700 PLOT 2,XT,YT
2720 PLOT 255
2740 NEXT I
2800 REM -DEVELOP THE SCALE VALUES FOR THE 'X' SCALE.
2820 IF XS< 0THEN 3280
2840 SX= XL/ 6
2860 REM - SX=FIRST GUESS AT X-SCALE INTERVAL.
2880 REM -SX MULTIPLIED BY 1000 TO PERMIT SX TO BE AS SMALL AS
2882 REM  -.001 AND STILL YIELD THE PROPER SCALE.DUE TO THE LIMIT
2884 REM - OF 6 DIGITS ON THE USE OF THE 'LEN' FUNCTION,THIS FAC-
2885 REM -TOR 0F 1000 IS NOT USED WHEN SX >100
2895 IF SX> 100THEN 2945
2900 NN= LEN (STR$ (INT (SX* 1000)))- 1
2920 REM -FIND THE VALUE OF FIRST DIGIT OF SX*1000
2940 S1= INT (SX* 1000)/ (10^ (NN- 1))
2942 GOTO 2960
2945 NN= LEN (STR$ (INT (SX)))- 1
2950 S1= INT (SX)/ (10^ (NN- 1))
2960 IF ABS (10- S1)< ABS (S1- 5)THEN S2= 10:GOTO 3050
2980 IF ABS (10- S1)> ABS (S1- 5)THEN S2= 5
3000 IF ABS (5- S1)> ABS (S1- 2)THEN S2= 2
3020 IF ABS (2- S1)> ABS (S1- 1)THEN S2= 1
3040 REM -RESTORE THE CORRECT NUMBER OF DIGITS TO SCALE INTERVAL.
3050 IF SX> 100THEN 3070
3060 S3= S2* (10^ (NN- 1))/ 1000
3065 GOTO 3090
3070 S3= S2* (10^ (NN- 1))
3080 REM -  H=NO.OF INTERVALS ON SCALE UP TO MAX. PLOTTED VALUE.
3090 IF XS< 0THEN 3400
3100 H= INT (XL/ S3)
3130 PLOT 29:PLOT 23
3140 FOR K= 0TO (H+ 1)
3145 REM -NP IS THE NUMBER OF CHARACTERS ,INCLUDING THE SIGN,OF
3147 REM - THE SCALE VALUES
3150 NP= LEN (STR$ (S3* K))
3170 REM - XX IS THE CURSOR POSITION(THERE ARE ONLY 64 POSSIBLE
3175 REM -POSITIONS COMPARED TO 128 POSSIBLE POINT POSITIONS)
3180 XX= 5+ ((S3* K)* (118/ XL)* .9* .5)- (NP/ 2)
3185 IF XX< 0OR XX> 60THEN 3240
3190 PLOT 27,24
3200 PLOT 3,XX,31- YX/ 4+ 2
3220 PRINT S3* K
3240 NEXT K
3260 GOTO 3580
3280 IF XS< 0AND XL> 0THEN 3300
3290 IF XL< 0THEN 3310
3300 SX= (XL- XS)/ 6:GOTO 2895
3310 SX= ABS (XS/ 6):GOTO 2895
3320 REM -SX=FIRST GUESS AT SCALE INTERVAL IF XS<0.SEE LINE
3325 REM -2820 FROM WHICH THE PROGRAM SHIFTS TO LINE 3280.
3390 REM - H1 =NO. OF INTERVALS ON THE NEGATIVE X AXIS
3400 IF XS< 0AND XL> 0THEN 3410
3405 IF XL< 0THEN 3525
3410 H1= INT (XS/ S3)
3420 H2= INT (XL/ S3)+ 1
3460 REM - H2 =NO. OF INTERVALS ON THE POSITIVE X AXIS
3465 PLOT 27,24
3470 PLOT 29:PLOT 23
3480 FOR K= H1TO H2
3490 NP= LEN (STR$ (S3* K))
3520 XX= (XY+ ((S3* K)* (128/ (XL- XS))* .9))* .5- (NP/ 2)
3521 IF XX< 0OR XX> 60THEN 3523
3522 PLOT 3,XX,31- YX/ 4+ 2:PRINT S3* K
3523 NEXT K
3524 GOTO 3580
3525 H= - INT (XS/ S3)
3526 PLOT 27,24
3528 PLOT 29:PLOT 23
3530 FOR K= 0TO H
3532 NP= LEN (STR$ (S3* K))
3535 XX= (XY+ (S3* K)* (128/ XS)* .9)* .5- (NP/ 2)
3537 IF XX< 0OR XX> 60THEN 3565
3540 PLOT 3,XX,31- YX/ 4- 2
3560 PRINT S3* K
3565 NEXT K
3570 REM  -LABELS ABSCISSA WITH THE LETTER 'X'
3580 PLOT 3,32,31- YX/ 4+ 3
3600 PRINT "X"
3700 PLOT 27,11
4000 REM -DEVELOP THE SCALE VALUES FOR THE 'Y' SCALE.
4020 IF YS< 0THEN 4485
4040 REM -SY=FIRST GUESS AT Y-SCALE INTERVAL.
4060 SY= YL/ 6
4065 IF SY> 100THEN 4145
4080 MM= LEN (STR$ (INT (SY* 1000)))- 1
4120 REM -FIND THE VALUE OF FIRST DIGIT OF SY*1000
4140 T1= INT (SY* 1000)/ (10^ (MM- 1))
4142 GOTO 4160
4145 MM= LEN (STR$ (INT (SY)))- 1
4150 T1= INT (SY)/ (10^ (MM- 1))
4160 IF ABS (10- T1)< ABS (T1- 5)THEN T2= 10:GOTO 4230
4180 IF ABS (10- T1)> ABS (T1- 5)THEN T2= 5
4200 IF ABS (5- T1)> ABS (T1- 2)THEN T2= 2
4220 IF ABS (2- T1)> ABS (T1- 1)THEN T2= 1
4230 IF SY> 100THEN 4250
4240 T3= T2* (10^ (MM- 1))/ 1000
4245 GOTO 4260
4250 T3= T2* (10^ (MM- 1))
4260 IF YS< 0THEN 4560
4280 REM -H=NO. OF INTERVALS ON SCALE UP TO MAX.PLOTTED VALUE.
4300 H= INT (YL/ T3)
4320 PLOT 29:PLOT 23
4340 FOR K= 0TO (H+ 1)
4360 REM -YY IS THE CURSOR POSITION(THERE ARE ONLY 32 POSSIBLES.)
4365 REM - THE SCALE VALUES ,IN PLOTTING UNITS,MUST BE ADJUSTED BY
4367 REM -32/128 OR .25 TO SET THE Y POSITION OF THE CURSOR.
4380 YY= 31+ 1- (10+ ((T3* K)* (118/ YL)* .9))* .25
4385 IF YY< 0OR YY> 31THEN 4460
4390 PLOT 27,24
4400 PLOT 3,(XY/ 2- 5),YY
4420 PRINT T3* K
4460 NEXT K
4480 GOTO 4740
4485 IF YS< 0AND YL> 0THEN 4500
4490 IF YL< 0THEN 4530
4500 SY= (YL- YS)/ 6
4520 GOTO 4065
4530 SY= ABS (YS/ 6):GOTO 4080
4560 IF YS< 0AND YL> 0THEN 4600
4570 IF YL< 0THEN 4686
4600 H1= INT (YS/ T3)
4620 H2= INT (YL/ T3)+ 1
4630 PLOT 27,24
4640 PLOT 29:PLOT 23
4660 FOR K= H1TO H2
4680 YY= 31+ 1- (YX+ (T3* K)* (128/ (YL- YS))* .9)* .25
4681 IF YY< 0OR YY> 31THEN 4684
4682 PLOT 3,(XY/ 2)- 3,YY
4683 PRINT T3* K
4684 NEXT K
4685 GOTO 4740
4686 H= - INT (YS/ T3)
4687 PLOT 27,24
4688 PLOT 29:PLOT 23
4690 FOR K= 0TO H
4695 YY= 31+ 1- (YX+ (T3* K)* (128/ YS)* .9)* .25
4697 IF YY< 0OR YY> 31THEN 4730
4700 PLOT 3,(XY/ 2)- 3,YY
4720 PRINT - T3* K
4730 NEXT K
4740 PLOT 3,(XY/ 2)- 3,17
4760 PRINT "Y"
4780 PLOT 27,11
5000 PLOT 3,20,4
5020 PRINT "TO RECALL EQUATION COEFFICIENTS,ENTER'COEF'"
5040 INPUT R$
5045 IF R$= "COEF"THEN ZZ= 2
5060 IF R$= "COEF"THEN 495
5100 PRINT "DO YOU WISH TO SEE THE PLOT AGAIN(Y OR N)?
5120 INPUT T$
5140 IF T$= "Y"THEN 1000
5160 IF T$= "N"THEN 5170
5170 PLOT 12
5180 PRINT "TO DO ANOTHER CASE,TYPE 'BREAK' AND THEN 'RUN'"
5200 END