Расчёт аппроксимаций по программе в среде 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 (Графики).