Расчёт аппроксимаций по программе в среде TURBO PASCAL 7.0

 

 

 

Program Kurs_MNK;

Uses Crt,Graph;

 

Const

Nmax=100;

 

Type

Vector=array[1..Nmax] of real;

ari=array[1..100] of longint;

 

Var

f,g:text;

filevvod:string;

x1,y1:ari;

x,y,lny,STL,SsrL,STsqr,Ssrsqr:Vector;

Ftab,Stab:vector;

YL,Ysqr,Yexp,lnYexp:Vector;

i,N,N1:integer;

Sx,Sy,Sxy,Sx2,Sx3,Sx4,Sx2y,Sx2sr,Sy2sr,Sxysr,Slny,Sxlny:real;

a1L,a2L,koef_cor:real;

Md:real;

Sa1L,Sa2L:real;

Xsr,Ysr,lnYsr:real;

SostL,SregrL,SpolnL,R_det_L:real;

FLine,SLine,ta1L,ta2L:real;

a1sqr,a2sqr,a3sqr:real;

Sa1sqr,Sa2sqr,Sa3sqr:real;

Sostsqr,Sregrsqr,Spolnsqr,R_det_sqr,DSost:real;

Fsqr,Ssqr,ta1sqr,ta2sqr,ta3sqr:real;

cexp,a1exp,a2exp:real;

Sa1exp,Sa2exp:real;

Sostexp,Sregrexp,Spolnexp,R_det_exp:real;

Fexp,ta1exp,ta2exp:real;

gr:integer;

Min,Max,Xpr,Ypr:real;

 

{Процедура ввода данных из файла}

Procedure Inp_vect(name:String; Var a,b:Vector; Var N:integer);

Var

k:integer;

f:text;

Begin

N:=0;

k:=1;

Assign(f,name); {Иннициализируем файловую переменную}

{$I-} {Проверяем существование файла}

reset(f);

{$I+}

if IOResult=0 then {Если файл с заданным именем существует}

begin

reset(f);

while not SeekEoLN(f) do

begin

while not SeekEoln(f) do

begin

ReadLn(f,a[k],b[k]);

N:=N+1;

k:=k+1;

end;

end;

close(f);

end

else WriteLn('файл с именем ',name,'не найден')

END;

 

{Процедура решения системы двух линейных уравнений методом Крамера}

Procedure L_Kram(Var a11:integer;Var a12,a21,a22,b1,b2:real;Var a1,a2:real);

Var

D,D1,D2:Real;

begin

D:=a11*a22-a21*a12;

D1:=b1*a22-b2*a12;

D2:=a11*b2-a21*b1;

a1:=D1/D;

a2:=D2/D;

end;

 

{Процедура решения системы трех линейных уравнений методом Крамера}

Procedure Sqr_Kram(Var a11:integer;

Var a12,a13,a21,a22,a23,a31,a32,a33,b1,b2,b3:real;

Var a1,a2,a3,MD:real);

Var

D,D1,D2,D3:Real;

begin

D:=a11*a22*a33+a12*a23*a31+a21*a32*a13-a13*a22*a31-a21*a12*a33-a11*a23*a32;

D1:=b1*a22*a33+a12*a23*b3+b2*a32*a13-a13*a22*b3-b2*a12*a33-b1*a23*a32;

D2:=a11*b2*a33+b1*a23*a31+a21*b3*a13-a13*b2*a31-a21*b1*a33-a11*a23*b3;

D3:=a11*a22*b3+a12*b2*a31+a21*a32*b1-b1*a22*a31-a21*a12*b3-a11*b2*a32;

a1:=D1/D;

a2:=D2/D;

a3:=D3/D;

MD:=D;

end;

 

{Процедура вычисления коэффициента детерминированности}

Procedure Koef_det(ns:integer;a,b:Vector;c:real;Var

S1,S2,S3,R:real);

Var

I:integer;

BEGIN

For i:=1 to NS do

begin

S1:=S1+sqr(b[i]-a[i]);

S2:=S2+sqr(b[i]-c);

end;

S3:=S1+S2;

R:=1-S1/S3;

end;

 

{Процедура вычисления стандартных ошибок коэфициентов

уравнения линейной регрессии и критериев для проверки

нулевых гипотез}

Procedure ZnachLine(n:integer;DS,R2,a,asr,a1,a2:real;Var

S1,S2,f,t1,t2:real);

begin

S1:=Sqrt(DS*a/(n*(n-2)*asr));

S2:=Sqrt(DS/((n-2)*asr));

f:=R2*(n-2)/(1-R2);

t1:=abs(a1)/S1;

t2:=abs(a2)/S2;

end;

 

{Процедура печати результатов работы программы в файл}

Procedure Print(Var gr:integer;sa1,sa2,sa3,sk,sR,sm1,sm2,sm3,sf,st1,st2,st3:string;a1,a2,a3,K,R,m1,m2,m3,f,t1,t2,t3:real);

Var

Fd,Sd:real;

st:string;

begin

Case gr of

1:st:='линеной аппроксимации';

2:st:='квадратичной аппроксимации';

3:st:='экспоненциальной аппроксимации';

end;

Write(g,sa1,'=',a1:7:4,' ',sa2,'=',a2:7:4);

if gr=2 then Write(g,' ',sa3,'=',a3:7:4);

WriteLn(g,' -коэффициенты',st);

If gr=1 then WriteLn(g,sk,k:9:6,' -коэффициент корреляции');

WriteLn(g,sR,r:9:6,'-коэффициент детерминированности');

Write(g,sm1,m1:8:6,' ',sm3,m2:8:6);

if gr=2 then Write(g,' ', sm3,m3:8:6);

WriteLN(g,' -стандартные ошибки коэффициентов');

WriteLN(g,'Критерии дя проверки нулевых гипотез:');

Write(g,sf,f:8:3,' ',st3,t1:8:3,' ',st2,t2:8:3);

if gr=2 then Write(g,' ', st3,t3:8:3);

WriteLn(g);

if gr=2 then Fd:=Ftab[2] else fd:=Ftab[1];

if gr=2 then Sd:=Stab[2] else Sd:=Stab[1];

if f>Fd THEN WriteLN(g,'Уравнение ',st,' значимо')

ELSE WriteLN(g,'Уравнение',st,' не значимо');

if t1>Sd THEN WriteLN(g,'Коэффициент',sa1,'значим')

ELSE WriteLN(g,'Коэффициент',sa1,'не значим');

if t2>Sd THEN WriteLN(g,'Коэффициент',sa2,'значим')

ELSE WriteLN(g,'Коэффициент',sa2,'не значим');

if gr=2 THEN

if t2>Sd THEN WriteLN(g,'Коэффициент',sa3,'значим');

end;

 

{Процедура построения исходных точек и линии тренда на экране}

Procedure Grafik(Var gr:integer);

Const

k=100; {колличество точек просчета}

kxn=95; kxk=590;

kyn=70; kyk=385; {параметры окна}

Var

dr,md,i:integer; {тип и режим адаптера}

x,y:vector;{массивы для значений функции и аргумента}

kx,ky:ari;{массивы для значений функции и аргумента}

ymin,ymax:real;{экстремальные значения у}

L:integer;

VOL:string;

mx,my:real;{масштабные коэффициенты}

h:real;{шаг по оси х}

 

{Функция для вывода целых чисел}

Function IntStr(L,DIG:integer):String;

Var buf:string[10];

begin

Str(L:DIG,Buf);

IntStr:=Buf;

end;

{Тело процедуры}

begin

ClrScr;

h:=30/(k-1);{определяем шаг по оси х}

x[1]:=0;

ymin:=0;

ymax:=100;

 

for i:=1 to k do {табулируем функцию}

begin Case gr of

1:y[I]:=a1L+a2L*x[I];

2:y[I]:=a1sqr+a2sqr*x[I]+a3sqr*x[I]*x[I];

3:y[I]:=a1exp*exp(a2exp*x[I]);

end;

if i<>100 then x[i+1]:=x[i]+h;

end;

mx:=(kxk-kxn)/(X[k]-x[1]); {определяем масштаб по оси х}

my:=(kyk-kyn)/(ymax-ymin); {определяем масштаб по оси у}

for i:=1 to k do {определяем координаты точек}

begin

kx[i]:=round((x[i]-x[1])*mx)+kxn;

ky[i]:=round((ymax-y[i])*my)+kyn;

end;

Dr:=detect;

InitGraph(dr,md,' '); {инициализируем графический режим}

setBKColor(7); {цвет фона светло серый}

ClearDevice; {очищаем экран}

SetColor(1); {текущий цвет синий}

SetLineStyle(0,0,2); {тип линии сплошная толщиной 2 пикселя}

Line(95,385,590,385); {рисуем координатную линию по х}

Line(95,385,95,70); {рисуем координатную линию по у}

SetTextStyle(1,0,2); {выбираем шрифт}

For I:=0 to 10 do begin

L:=100-I*10;

VOL:=IntStr(L,3);

OutTextXY(30,50+I*32,VOL); {выводим значения функции}

end;

For I:=0 to 6 do begin

L:=0+I*5;

VOL:=IntStr(L,3);

OutTextXY(70+I*85,390,VOL); {выводим значения аргумента}

end;

For I:=1 to N do {выводим исходные данные в виде}

Circle(x1[I],y1[I],2); {окружностей радиусом 2 пикселя}

Case gr of {выводим заголовок}

1:OutTextXY(250,70,'y=a1L+a2L*x');

2:OutTextXY(180,70,'y=a1sqr+a2sqr*x+a3sqr*x^2');

3:OutTextXY(220,70,'y=a1exp*(a2exp*x)');

end;

SetColor(4); {текущий цвет красный}

for i:=1 to k-1 do {рисуем линию тренда}

Line(kx[i],ky[i],kx[i+1],ky[i+1]);

readKey; {ждем нажатия на любую клавишу}

Closegraph {закрываем графический режим}

end;

{Процедура вычисления минимального и максимального значений в массиве}

Procedure MinMax(Var A:vector;Var n:integer;Var Min,Max:real);

Var i:integer;

begin

Min:=A[1];

Max:=A[1];

For i:=2 to n do begin

if A[i]<Min then Min:=A[i];

if A[i]>Max then Max:=A[i];

end;

end;

{Начало основного блока программы}

BEGIN

WriteLn('Введите полное имя файла с исходными данными');

Readln(filevvod);

Inp_vect(filevvod,x,y,N); {Вводим исходные данные}

writeLn('Введите полное имя файла с табличными данными');

Readln(filevvod);

Inp_vect(filevvod,Ftab,Stab,N1); {Вводим табличные данные}

{Вычисляем вспомогательные суммы}

Sx:=0; Sy:=0; Sx2:=0; Sxy:=0;

Sx3:=0;Sx4:=0; Sx2y:=0;

Slny:=0; Sxlny:=0;

for i:=1 to N do begin

Sx:=Sx+x[i];

Sy:=Sy+y[i];

Sx2:=Sx2+sqr(x[i]);

Sxy:=Sxy+x[i]*y[i];

Sx3:=Sx3+sqr(x[i])*x[i];

Sx4:=Sx4+sqr(sqr(x[i]));

Sx2y:=Sx2y+sqr(x[i])*y[i];

lny[i]:=ln(y[i]);

slny:=Slny+lny[i];

Sxlny:=Sxlny+x[i]*lny[i];

end;

{вычисляем средние значение по x,y и lny}

Xsr:=Sx/N;

Ysr:=Sy/N;

lnYsr:=Slny/N;

Sxysr:=0; Sx2sr:=0; Sy2sr:=0;

For i:=1 to N do begin

Sxysr:=Sxysr+(x[i]-Xsr)*(y[i]-Ysr);

Sx2sr:=Sx2sr+sqr(x[i]-Xsr);

Sy2sr:=Sy2sr+sqr(y[i]-Ysr);

end;

{Вычисляем коэффициенты уравнения регрессии для линейной аппроксимации}

L_Kram(N,Sx,Sx,Sx2,Sy,Sxy,a1L,a2L);

{Вычисляем коэффициент корредяции}

Koef_cor:=Sxysr/(sqrt(Sx2sr)*sqrt(Sy2sr));

{Вычмсляем коэффициент детерминирования для линейной аппроксимации}

For i:=1 to N do YL[i]:=a1L+a2L*x[i];

koef_det(N,y,YL,Ysr,SostL,SregrL,SpolnL,R_det_L);

{Вычисляем стандартные ошибки коэффициентов уравнения линейной регрессии

и критерии для проверки нулевых гипотез}

ZnachLine(N,SostL,R_det_L,Sx2,SX2sr,a1L,a2L,Sa1L,Sa2L,

FLine,ta1L,ta2L);

{Вычисляем коэффициенты уравнения регрессии для квадратичной

аппроксимации}

Sqr_Kram(N,Sx,Sx2,Sx,Sx2,Sx3,Sx2,Sx3,Sx4,Sy,Sxy,Sx2y,

a1sqr,a2sqr,a3sqr,MD);

{Вычисляем коэффициент детерминированности для квадратичной

аппроксимации}

For i:=1 to N do Ysqr[i]:=a1sqr+a2sqr*x[i]+a3sqr*sqr(x[i]);;

koef_det(N,y,Ysqr,Ysr,Sostsqr,Sregrsqr,Spolnsqr,R_det_sqr);

{Вычисляем стандартные ошибки коэффициентов уравнения квадратичной

регрессии и критерии для проверки нулевых гипотез}

DSost:=Sostsqr/(n-3);

Sa1sqr:=Sqrt(DSost*(Sx2*Sx4-Sx3*Sx3)/MD);

Sa2sqr:=Sqrt(DSost*(N*Sx4-Sx2*Sx2)/MD);

Sa3sqr:=Sqrt(DSost*(N*Sx2-Sx*Sx)/MD);

Fsqr:=R_det_sqr*(n-3)/(2*(1-R_det_sqr));

ta1sqr:=abs(a1sqr)/Sa1sqr;

ta2sqr:=abs(a2sqr)/Sa2sqr;

ta3sqr:=abs(a3sqr)/Sa3sqr;

{Вычисляем коэффициенты уравнения регрессии для

экспоненциальной аппроксимации}

L_Kram(N,Sx,Sx,Sx2,Slny,Sxlny,Cexp,a2exp);

a1exp:=exp(cexp);

{Вычисляем коэффициент детерминированности для

экспоненциальной аппроксимации}

For i:=1 to N do

begin

Yexp[i]:=a1exp*exp(a2exp*x[i]);

lnYexp[i]:=Ln(Yexp[i]);

end;

koef_det(N,lny,lnYexp,lnYsr,Sostexp,Sregrexp,

Spolnexp,R_det_exp);

{Вычисляем стандартные ошибки коэффициентов уравнения

экспоненциальной регрессии и критерии для проверки нулевых

гипотез}

ZnachLine(N,Sostexp,R_det_exp,Sx2,SX2sr,a1exp,a2exp,

Sa1exp,Sa2exp,Fexp,ta1exp,ta2exp);

{Печатаем исходные и табличные данные в выходной файл

out.dat}

Assign(g,'d:\1\26\out.dat');

Rewrite(g);

WriteLn(g,' Исходные данные');

For i:=1 to N do writeln(g,x[i]:6:2,' ',y[i]:6:2);

writeln(g,' N=',N:2,'-число наблюдений');

writeln(g,'Табличные данные');

For i:=1 to N1 do WriteLn(g,Ftab[i]:6:2,' ',Stab[i]:8:4);

{Вывод результатов для линейной аппроксимации}

gr:=1;

Print(gr,'a1L','a2L','','koef_cor=','R_det_L=','Sa1L=','Sa2L=','',

'FLine=','ta1L=','ta2L','',a1L,a2L,0,koef_cor,R_det_L,

Sa1L,Sa2L,0,FLine,ta1L,ta2L,0);

{Вывод результатов для квадратичной аппроксимации}

gr:=2;

Print(gr,'a1sqr','a2sqr','a3sqr','','R_det_sqr=','Sa1sqr=','Sa2sqr=',

'Sa3sqr=','Fsqr=','ta1sqr=','ta2sqr','ta3sqr=',a1sqr,a2sqr,a3sqr,0,

R_det_sqr,Sa1sqr,Sa2sqr,Sa3sqr,Fsqr,ta1sqr,ta2sqr,ta3sqr);

{Вывод результатов для экспоненциальной аппроксимации}

gr:=3;

Print(gr,'a1exp','a2exp','','','R_det_exp=','Sa1exp=','Sa2exp=','',

'Fexp=','ta1exp=','ta2exp=','',a1exp,a2exp,0,0,R_det_exp,

Sa1exp,Sa2exp,0,Fexp,ta1exp,ta2exp,0);

{Вычисление прогнозных значений}

MinMax(x,N,Min,Max);

Xpr:=Xsr+0.1*(Max-Min);

Ypr:=a1L+a2L*Xpr;

Writeln(g,'В прогнозной точке Xpr=',Xpr:6:4,'прогнозное значение Ypr=',Ypr:6:4);

Close(g);

{Вычисляем координаты точек исходного массива}

For I:=1 to N do begin

x1[I]:=Round(95+x[I]*495/30);

y1[I]:=Round(385-y[I]*y[I]*315/100);

end;

{Рисуем линию тренда для линейной аппроксимации}

gr:=1;

Grafik(gr);

{Рисуем линию тренда для квадратичной аппроксимации}

gr:=2;

Grafik(gr);

{Рисуем линию тренда для экспоненциальной аппроксимации}

gr:=3;

Grafik(gr);

END.

 

В результате чего был создан файл out.txt.

Его содержимое таково:

Исходные данные

1.20 2.00

1.40 3.50

1.60 5.00

1.80 5.60

2.00 6.60

3.00 7.80

4.00 9.00

5.00 9.10

6.00 9.20

7.00 9.40

8.00 9.45

9.00 9.50

10.00 9.50

N=13-число наблюдений

Табличные данные

4.84 3.1058

4.96 3.1693

a1L= 4.2172 a2L= 0.6804 -коэффициентылиненой аппроксимации

koef_cor= 0.821048 -коэффициент корреляции

R_det_L= 0.674120-коэффициент детерминированности

Sa1L=0.784483 0.142642 -стандартные ошибки коэффициентов

Критерии дя проверки нулевых гипотез:

FLine= 22.755 5.376 ta2L 4.770

Уравнение линеной аппроксимации значимо

Коэффициентa1Lзначим

Коэффициентa2Lзначим

a1sqr= 1.0635 a2sqr= 2.4917 a3sqr=-0.1721 -коэффициентыквадратичной аппроксимации

R_det_sqr= 0.891278-коэффициент детерминированности

Sa1sqr=0.850779 Sa3sqr=0.414388 Sa3sqr=0.038512 -стандартные ошибки коэффициентов

Критерии дя проверки нулевых гипотез:

Fsqr= 40.989 ta3sqr= 1.250 ta2sqr 6.013 ta3sqr= 4.469

Уравнение квадратичной аппроксимации значимо

Коэффициентa1sqrне значим

Коэффициентa2sqrзначим

Коэффициентa3sqrзначим

a1exp= 4.0070 a2exp= 0.1131 -коэффициентыэкспоненциальной аппроксимации

R_det_exp= 0.535116-коэффициент детерминированности

Sa1exp=0.174871 0.031797 -стандартные ошибки коэффициентов

Критерии дя проверки нулевых гипотез:

Fexp= 12.662 22.914 ta2exp= 3.558

Уравнение экспоненциальной аппроксимации значимо

Коэффициентa1expзначим

Коэффициентa2expзначим

В прогнозной точке Xpr=5.4954прогнозное значение Ypr=7.9565

Вывод.

 

 

В курсовой работе мы решили задачу проведение испытаний установления зависимости массы фракций на погонный метр удлинённого заряда гранулита АС-8 от относительного расстояния, определили тип и параметры аналитической зависимости, аппроксимирующей результаты испытаний. Используя компьютерные возможности, которые мы проходили на первом курсе нашего обучения в СПГГИ, и методические указания. Это во многом облегчило нам решение поставленной задачи. Курсовая выполнена и оформлена программами: текстовый редактор Microsoft Word, электронные таблицы Microsoft Excel. Программа на языке программирования Паскаль является реализацией цикла табулирования. Полученные ответы, выполненные разными программами, сходятся и проверены.

 

Список литературы.

1. Методическое указание по выполнению курсовой работы / Санкт-Петербургский государственный горный институт (технический университет). Сост. Г.Н.Журов, В.В.Беляев, Г.П.Парамонов. СПб, 2010. 54 с.

2. Беляев В.В. Информатика. Аппроксимация методом наименьших квадратов. Методическое указание по выполнению курсовой работы студентов всех специальностей. / В.В. Беляев, Г.Н. Журов. СПб.: СПГГИ(ТУ), 2005.

 

11.Приложения

Рис 15.Образ в программе Microsoft Excel.

 

Рис 16.Образ в программе Microsoft Excel.

 

 

Рис 17.Образ в программе Microsoft Excel.

Рис 18 Образ в программе Microsoft Excel (Графики).