Var I : integer;

begin { setup }

for i:=1 to nrow do

begin

b[i,j]:=y[i];

if j>1 then b[i,j-1]:=a[i,j-1]

end;

coef[j]:=deter(b)/det

end; { setup }

begin { procedure solve }

error:=false;

for i:=1 to nrow do

for j:=1 to nrow do

b[i,j]:=a[i,j];

det:=deter(b);

if det=0.0 then

begin

error:=true;

writeln(chr(7),'ERROR: matrix is singular')

end

else

begin

setup(b,coef,1);

setup(b,coef,2);

setup(b,coef,3)

end { esle }

end; { procedure solve }

procedure linfit(x,y: ary;

var y_calc: ary;

var coef: arys;

nrow: integer;

var ncol: integer);

{ least squares fit to a parabola }

{ nrow sets of x and y pair points }

var a : ary2s;

g : arys;

I : integer;

error : boolean;

sum_x,sum_y,sum_xy,sum_x2,

sum_y2,xi,yi,sxy,syy,

sxx,sum_x3,sum_x4,sum_2y,

denom,srs,x2 : real;

begin { linfit }

ncol:=3; { polynomial terms }

sum_x:=0.0;

sum_y:=0.0;

sum_xy:=0.0;

sum_x2:=0.0;

sum_y2:=0.0;

sum_x3:=0.0;

sum_x4:=0.0;

sum_2y:=0.0;

for i:=1 to nrow do

begin

xi:=x[i];

yi:=y[i];

x2:=xi*xi;

sum_x:=sum_x+xi;

sum_y:=sum_y+yi;

sum_xy:=sum_xy+xi*yi;

sum_x2:=sum_x2+x2;

sum_y2:=sum_y2+yi*yi;

sum_x3:=sum_x3+xi*x2;

sum_x4:=sum_x4+x2*x2;

sum_2y:=sum_2y+x2*yi

end;

a[1,1]:=nrow;

a[2,1]:=sum_x; a[1,2]:=sum_x;

a[3,1]:=sum_x2; a[1,3]:=sum_x2;

a[2,2]:=sum_x2; a[3,2]:=sum_x3;

a[2,3]:=sum_x3; a[3,3]:=sum_x4;

g[1]:=sum_y;

g[2]:=sum_xy;

g[3]:=sum_2y;

solve(a,g,coef,ncol,error);

srs:=0.0;

for i:=1 to nrow do

begin

y_calc[i]:=coef[1]+coef[2]*x[i]+coef[3]*sqr(x[i]);

srs:=srs+sqr(y[i]-y_calc[i])

end;

correl_coef:=sqrt(1.0-srs/(sum_y2-sqr(sum_y)/nrow))

end; { linfit }

{ external procedure plot(x,y,y_calc: ary; nrow: integer);

}

{$I C:PLOT.LIB } { get ptocedure PLOT }

begin { MAIN program }

ClrScr;

get_data(x,y,nrow);

linfit(x,y,y_calc,coef,nrow,ncol);

write_data;

plot(x,y,y_calc,nrow)

end. { MAIN }

Программа 24.

(Требуется согласовать упрощения)

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 }