Скачиваний:
22
Добавлен:
01.05.2014
Размер:
258.05 Кб
Скачать

Var I : integer;

sum_x,sum_y,sum_xy,sum_x2,

sum_y2,xi,yi,sxy,sxx,

syy : real;

begin { linfit }

sum_x:=0.0;

sum_y:=0.0;

sum_xy:=0.0;

sum_x2:=0.0;

sum_y2:=0.0;

for i:=1 to n do

begin

xi:=x[i];

yi:=y[i];

sum_x:=sum_x+xi;

sum_y:=sum_y+yi;

sum_xy:=sum_xy+xi*yi;

sum_x2:=sum_x2+xi*xi;

sum_y2:=sum_y2+yi*yi;

end;

sxx:=sum_x2-sum_x*sum_x/n;

sxy:=sum_xy-sum_x*sum_y/n;

syy:=sum_y2-sum_y*sum_y/n;

b:=sxy/sxx;

a:=((sum_x2*sum_y-sum_x*sum_xy)/n)/sxx;

for i:=1 to n do

y_calc[i]:=a+b*x[i]

end; { LINFIT }

Программа 28. Приближенная линеаризация опытных данных (вар.2).

procedure linfit2(x,y: ary;

var y_calc: ary;

var a,b: real;

n: integer);

{ fit a straight line (y_calc) through n sets of x and y pairs of points }

Var I : integer;

sum_x,sum_y,sum_xy,sum_x2,

sum_y2,xi,yi,sxy,syy,

sxx : real;

begin { linfit }

sum_x:=0.0;

sum_y:=0.0;

sum_xy:=0.0;

sum_x2:=0.0;

sum_y2:=0.0;

for i:=1 to n do

begin

xi:=x[i];

yi:=y[i];

sum_x:=sum_x+xi;

sum_y:=sum_y+yi;

sum_xy:=sum_xy+xi*yi;

sum_x2:=sum_x2+xi*xi;

sum_y2:=sum_y2+yi*yi;

end;

sxx:=sum_x2-sum_x*sum_x/n;

sxy:=sum_xy-sum_x*sum_y/n;

syy:=sum_y2-sum_y*sum_y/n;

b:=sxy/sxx;

a:=((sum_x2*sum_y-sum_x*sum_xy)/n)/sxx;

correl_coef:=sxy/sqrt(sxx*syy);

see:=sqrt((sum_y2-a*sum_y-b*sum_xy)/(n-2));

sigma_b:=see/sqrt(sxx);

sigma_a:=sigma_b*sqrt(sum_x2/n);

for i:=1 to n do

y_calc[i]:=a+b*x[i]

end; { LINFIT }

Программа 29. Модель диффузии Zn в CU на основе нелинейного МНК.

program nlin3;

{ Pascal program to perform a nonlinear least-squares fit for the diffusion

of Zn in CU }

const maxr = 20; { data prints }

maxc = 4; { polynomial terms }

r = 1.987; { gas constant }

type

index = 1..maxr;

ary = array[index] of real;

arys = array[1..maxc] of real;

ary2 = array[1..maxr,1..maxc] of real;

var

x,y,y_calc : ary;

t,d,ex : ary;

coef : arys;

I,n : integer;

nrow,ncol : integer;

done,error : boolean;

correl_coef,srs,

a,b,x2 : real;

procedure get_data(var x,y: ary;

var n: integer);

{ get values for n and arrays t,d }

Var I : integer;

begin

n:=7;

t[1]:=600.0; d[1]:=1.4E-12;

t[2]:=650.0; d[2]:=5.5E-12;

t[3]:=700.0; d[3]:=1.8E-11;

t[4]:=750.0; d[4]:=6.1E-11;

t[5]:=800.0; d[5]:=1.6E-10;

t[6]:=850.0; d[6]:=4.4E-10;

t[7]:=900.0; d[7]:=1.2E-9;

for i:=1 to n do

begin

x[i]:=1.0/(t[i]+273.0);

y[i]:=d[i]

end

end; { proceddure get data }

procedure write_data;

{ print out the answers }

Var I : integer;

begin

writeln;

writeln;

writeln(' I TC D DCALC');

for i:=1 to n do

writeln(i:3,t[i]:8:0,d[i],' ',y_calc[i]);

writeln; writeln(' Coefficients ');

writeln(coef[1],' constant term');

for i:=2 to ncol do

writeln(coef[i]); { other terms }

writeln;

writeln('D0=',a:7:2,' cm sq/sec.');

writeln('Q =',(-r*b/1000.0):8:2,'kcal/mole');

writeln;writeln('SRS= ',srs:8:4)

end; { write_data }

procedure func(b: real;

var fb,dfb: real);

Соседние файлы в папке lab1