Приложение 4. Компьютерная программа проведения многофакторного корреляционно-регрессионного анализа

1 COLOR 7,0:CLS:LOCATE 2,60,0:COLOR 25,5,15

2 COLOR 7,7,15:LOCATE 4:COLOR 0,7,15

3 PRINT TAB(27)"ЗАДАЧА KORREG";:PRINT SPC(37):PRINT TAB(26)" ";

4 COLOR 15,0,15:PRINT"КАФЕРА";:COLOR 23,5,15:PRINT"*БНТУ*";

5 COLOR 15,0,15:PRINT" ОАПДД ";:COLOR 7,7,15:PRINT SPC(35):COLOR 1,14

6 PRINT TAB(22)"КОРРЕЛЯЦИОННО-РЕГРЕССИОННЫЙ";

7 PRINT TAB(80)" ";:PRINT TAB(31)"А Н А Л И З";

8 PRINT TAB(80)" ":DEFINT I-N

19 PRINT:COLOR 7,0,7

OPEN"O",#1,"KORREG.REZ"

130 H0$=" ВЫ ДОПУСТИЛИ ОШИБКУ":H1$=" ЗНАЧЕНИЯ ":H4$="ВВЕДИТЕ"

140 H5$=" ФАКТОРА":H6$="ОПЫТА":H7$="КОРРЕКТИРОВАТЬ"

150 H8$=" ИСХОДНЫЕ ДАННЫЕ":F$="+#.##^^^^"

160 H9$=" ЧЕРЕЗ ЗАПЯТУЮ ПОРЯДКОВЫЕ НОМЕРА "

170 P4$="НОВАЯ ВЕЛИЧИНА "

180 PRINT"ВВЕДЕНЫ ЛИ "H8$".ДА- 1,НЕТ- 0":INPUT M0:CLS

190 IF M0=0 THEN 390

195 INPUT"ЗАДАЙТЕ СПЕЦИФИКАЦИЮ ФАЙЛА ДАННЫХ";FAI$

200 OPEN"I",#2,FAI$

210 INPUT #2,K,NN

220 GOSUB 620

230 FOR I=0 TO K:FOR J=O TO N:INPUT #2,X0(J,I):NEXT J:NEXT I

240 CLOSE #2

250 CLS:PRINT TAB(10)H8$

260 PRINT " Y";:FOR I=1 TO K:PRINT TAB(10*I+4)"X("I")";:NEXT I

270 PRINT:FOR J=0 TO N:PRINT J+1;:FOR I=0 TO K

280 PRINT TAB(10*I+4)USING F$;X0(J,I);:NEXT I:PRINT

282 IF J+1 MOD 20=0 THEN INPUT AAA:CLS

285 NEXT J

288 PRINT

290 COLOR 0,10,2

300 PRINT H7$" "H8$". ДА- 1,НЕТ- 0";:COLOR 7,0,7:INPUT M8

310 IF M0=0 AND M8=0 THEN 500

320 IF M8=0 THEN 560

330 M0=0

340 PRINT H4$;H9$;H6$;" И"H5$

350 PRINT " ( ФУНКЦИЮ СЧИТАТЬ НУЛЕВЫМ ФАКТОРОМ )"

360 INPUT JS,IS

370 IF JS<1 OR IS<0 OR IS>K OR JS>NN THEN PRINT H0$:BEEP:GOTO 340

380 PRINT P4$:INPUT X0(IS,JS)

385 GOTO 290

390 CLS:PRINT H4$;H8$

400 INPUT"ЧИСЛО ФАКТОРОВ";K

410 INPUT"ЧИСЛО ОПЫТОВ";NN

420 GOSUB 620

430 PRINT" ПОСЛЕДОВАТЕЛЬНО ЧИСЛО И ВВОД"

440 FOR I=1 TO K

450 PRINT H4$;H1$;I" -ГО"H5$

460 FOR J=0 TO N:INPUT X0(J,I):NEXT J:NEXT I

470 PRINT" ФУНКЦИИ"

480 FOR J=0 TO N:INPUT X0(J,0):NEXT J:PRINT

490 GOTO 250

500 INPUT"ЗАДАЙТЕ СПЕЦИФИКАЦИЮ ФАЙЛА ДЛЯ ДАННЫХ";FAI$

505 OPEN"O",#2,FAI$

510 WRITE #2,K,N+1

520 FOR I=0 TO K

530 FOR J=0 TO N:WRITE #2,X0(J,I)

540 NEXT J:NEXT I

550 CLOSE #2

560 REM

570 PRINT "УРАВНЕНИЕ ИМЕЕТ АДДИТИВНЫЙ ВИД- ВВЕДИТЕ 1"

580 PRINT "ИЛИ МУЛЬТИПЛИКАТИВНЫЙ ВИД- ВВЕДИТЕ 0":INPUT M8

590 PRINT "УРАВНЕНИЕ ИМЕЕТ СВОБОДНЫЙ ЧЛЕН ? ДА- 1,НЕТ- 0"

600 INPUT M7:M7=1-M7

610 GOTO 650

620 N=NN-1:K4=K*2+1:K5=K+4:K6=K+1:K7=K+3

630 DIM X0(N,K5),X1(K,K4),X2(K,N),X3(K,K4),X5(N)

640 RETURN

650 C=.001

660 FOR J=0 TO N:X0(J,K6)=X0(J,0):NEXT J

665 IF M7=1 THEN 680

670 FOR J=0 TO N:X0(J,0)=1:NEXT J

680 S7=0:S8=0

690 FOR I=O TO N:S7=S7+X0(I,K6)^2:S8=S8+X0(I,K6):NEXT I

700 S9=S7-S8*S8/(N+1)

710 PRINT #1, TAB(5)"РЕЗУЛЬТАТЫ";

720 PRINT #1," КОРРЕЛЯЦИОННО-РЕГРЕССИОННОГО АНАЛИЗА"

730 PRINT #1,:PRINT #1, TAB(5)"ЗНАЧЕНИЯ ФАКТОРОВ"

740 PRINT #1," I";

750 FOR J=1 TO K:PRINT #1," X("J")";:NEXT J:PRINT #1,

760 FOR I=0 TO N:PRINT #1, I+1;

770 FOR J=1 TO K:PRINT #1, TAB(10*J-4) USING F$;X0(I,J);:NEXT J

775 PRINT #1,:NEXT I

780 IF M8=1 THEN 810

790 FOR J=1 TO K:FOR I=0 TO N:X0(I,J)=LOG(X0(I,J)):NEXT I:NEXT J

800 FOR I=0 TO N:X5(I)=X0(I,K6):X0(I,K6)=LOG(X0(I,K6)):NEXT I

810 FOR I=M7 TO K:FOR J=0 TO N:X2(I,J)=X0(J,I):NEXT J:NEXT I

820 GOSUB 840

830 GOTO 880

840 FOR I=M7 TO K:FOR J=M7 TO K:A=0

850 FOR L=0 TO N:A=A+X2(I,L)*X0(L,J):NEXT L

860 X1(I,J)=A:NEXT J:NEXT I

870 RETURN

880 FOR I=M7 TO K:FOR J=M7 TO K

890 IF I<>J THEN X1(I,J+K6)=0:GOTO 910

900 X1(I,J+K6)=1

910 NEXT J

920 NEXT I

930 K1=M7

940 IF K=M7 THEN X1(1,K+2)=1/A:GOTO 1270

950 GOSUB 1830

960 K2=K1:IF K2>=K-1 THEN 980

970 K1=K1+1:GOTO 950

980 B3=1:FOR I=M7 TO K:B3=B3*X1(I,I):NEXT I

990 IF B3=0 THEN PRINT #1, "ОПРЕДЕЛИТЕЛЬ РАВЕН НУЛЮ ":GOTO 1950

1000 FOR I=K6 TO K4

1010 X1(K,I)=X1(K,I)/X1(K,K):NEXT I

1020 K2=K-1

1030 FOR I=M7 TO K2:FOR J=K6 TO K4

1040 X1(I,J)=X1(I,J)-X1(I,K2+1)*X1(K2+1,J)

1050 NEXT J:NEXT I

1060 K2=K2-1:IF K2>=M7 THEN 1030

1070 GOSUB 840

1080 FOR I=M7 TO K:FOR J=M7 TO K

1090 IF I<>J THEN X3(I,J)=0:GOTO 1110

1100 X3(I,J)=1

1110 NEXT J

1120 NEXT I

1130 FOR I=M7 TO K:FOR J=M7 TO K:A=0

1140 FOR L=M7 TO K:A=A+X1(I,L)*X1(L,J+K6):NEXT L

1150 X3(I,J)=2*X3(I,J)-A:NEXT J:NEXT I

1160 FOR I=M7 TO K:FOR J=M7 TO K:A=0

1170 FOR L=M7 TO K:A=A+X1(I,L+K6)*X3(L,J):NEXT L

1180 X3(I,J+K6)=A:NEXT J:NEXT I

1190 FOR I=M7 TO K:FOR J=M7 TO K

1200 X1(I,J+K6)=X3(I,J+K6):NEXT J:NEXT I

1210 A1=0:FOR I=M7 TO K:FOR J=M7 TO K

1220 A1=A1+ABS(X3(I,J)):NEXT J:NEXT I

1230 A2=0:FOR I=M7 TO K:A2=A2+ABS(X3(I,I)):NEXT I

1240 IF A1-A2<C GOTO 1270

1250 PRINT "СИСТЕМА СЛАБО ОБУСЛОВЛЕНА. &А=";A1-A2

1260 GOTO 1080

1270 FOR I=M7 TO K:A=0

1280 FOR L=0 TO N:A=A+X2(I,L)*X0(L,K6):NEXT L

1290 X0(I,K7)=A:NEXT I

1300 FOR I=M7 TO K:A=0

1310 FOR L=M7 TO K:A=A+X1(I,L+K6)*X0(L,K7):NEXT L

1320 X0(I,K5)=A:NEXT I

1330 FOR I=0 TO N:A=0

1340 FOR L=M7 TO K:A=A+X0(I,L)*X0(L,K5):NEXT L

1350 X0(I,K7)=A:NEXT I

1360 A3=0:A6=0:A7=0:A8=0

1370 FOR I=0 TO N

1380 A6=A6+(X0(I,K6)-X0(I,K7))^2

1390 IF M8=1 THEN 1440

1400 X0(I,K7)=EXP(X0(I,K7))

1410 A8=A8+(X0(I,K7)-X5(I))^2

1420 A3=A3+ABS((X0(I,K7)-X5(I))/X0(I,K7))

1430 GOTO 1450

1440 A3=A3+ABS((X0(I,K6)-X0(I,K7))/X0(I,K7))

1450 NEXT I

1460 IF M8=0 THEN S2=A8:GOTO 1480

1470 S2=A6

1480 E=A3/(N+1)

1490 PRINT #1,:PRINT #1, TAB(5)"УРАВНЕНИЕ РЕГРЕССИИ Y = ";

1500 IF M8=1 AND M7=0 THEN 1530

1510 IF M8=1 THEN 1580

1515 IF M7=1 THEN 1550

1520 PRINT #1, USING F$;EXP(X0(0,K5));:PRINT #1,"*":GOTO 1550

1530 PRINT #1, USING F$;X0(0,K5);:PRINT #1, " + ":GOTO 1580

1540 PRINT #1,

1550 FOR I=1 TO K:PRINT #1, "*X("I")^";

1560 PRINT #1, USING F$;X0(I,K5);:NEXT I

1570 GOTO 1600

1580 FOR I=1 TO K:PRINT #1, " ";:PRINT #1, USING F$;X0(I,K5);

1590 PRINT #1," X("I")";:NEXT I

1600 PRINT #1,

1610 PRINT #1," I","Y ЭКСПЕР.","Y ТЕОРЕТ."

1620 IF M8=0 THEN 1660

1630 FOR I=0 TO N:PRINT #1, I+1;

1640 PRINT #1, TAB(14)USING F$;X0(I,K6);

1645 PRINT #1, TAB(28)USING F$;X0(I,K7):NEXT I

1650 GOTO 1680

1660 FOR I=0 TO N:PRINT #1, I+1;

1670 PRINT #1, TAB(14)USING F$;X5(I);

1675 PRINT #1, TAB(28) USING F$;X0(I,K7):NEXT I

1680 PRINT #1, :PRINT #1, "S^2 ОСТАТОЧНАЯ =";:PRINT #1, USING F$;S2

1690 PRINT #1, "S^2 ПОЛНАЯ=";:PRINT #1, USING F$;S9

1700 IF S9>S2 GOTO 1720

1710 PRINT"ПРИНЯТЫЙ ВИД УРАВНЕНИЯ РЕГРЕССИИ НЕ ПОДХОДИТ":GOTO 1950

1720 R=SQR((S9-S2)/S9)

1730 PRINT #1, "КОЭФФИЦИЕНТ МНОЖЕСТВЕННОЙ КОРРЕЛЯЦИИ R=";

1735 PRINT #1, USING F$;R

1740 PRINT #1, "КОЭФФИЦИЕНТ ЛИНЕЙНОЙ ОШИБКИ";

1750 PRINT #1," АППРОКСИМАЦИИ E=";:PRINT #1, USING F$;E

1760 PRINT #1, "КРИТЕРИЙ ФИШЕРА F=";

1765 PRINT #1, USING F$;(S9-S2)*(N-K)/(S2*K)

1770 PRINT #1, "КРИТЕРИЙ СТЬЮДЕНТА Т ДЛЯ ПАРАМЕТРОВ УРАВНЕНИЯ"

1780 S=A6/(N-K)

1790 FOR I=M7 TO K

1800 T=ABS(X0(I,K5)/SQR(S*X1(I,I+K6)))

1810 PRINT #1, "T("I")=";:PRINT #1, USING F$;T:NEXT I

1820 PRINT #1,:PRINT #1, ".....***.....":PRINT #1,:GOTO 1950

1830 I1=K1

1840 IF X1(I1,K1)<>0 THEN K2=I1:GOTO 1870

1850 I1=I1+1:IF I1>K THEN 1940

1860 GOTO 1840

1870 FOR J1=K1 TO K4:B1=X1(K1,J1):X1(K1,J1)=X1(K2,J1)

1880 X1(K2,J1)=B1:NEXT J1

1890 FOR J2=K1+1 TO K4

1900 X1(K1,J2)=X1(K1,J2)/X1(K1,K1):NEXT J2

1910 FOR I3=K1+1 TO K:FOR J3=K1+1 TO K4

1920 X1(I3,J3)=X1(I3,J3)-X1(K1,J3)*X1(I3,K1)

1930 NEXT J3:NEXT I3

1940 RETURN

1950 COLOR 7,0:CLS:CLOSE #1

1952 COLOR 25,5,15:PRINT " РЕЗУЛЬТАТЫ РАСЧЕТА В ФАЙЛЕ KORREG.REZ"

1954 PRINT " ИСХОДНЫЕ ДАННЫЕ ДЛЯ ПОВТОРНОГО РАСЧЕТА В ФАЙЛЕ "FAI$

1956 BBB$=INKEY$

1958 IF LEN(BBB$)=0 THEN 1956

1960 END