VPF::Метод наименьших квадратов для

Alex1984

Дата 10.5.2006, 12:04 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 299
Регистрация: 6.3.2005
Где: Киев

Репутация: нет
Всего: 2

нужна программа АПРОКСИМАЦИИ ФУНКЦИИ НЕСКОЛЬКИХ ПЕРЕМЕННЫХ (Больше двух) мтодом наименьших квадратов.
F(x,y,z)
Задана таблица
...............x..y..z..F(x,y,z)
...............1..2..1.....5
...............4..5..6....18
...............1..2..6.....8
...............1..5..12...19
нужна найти функцию по данным таблици.
Напишите или растолкуте как прога должна выглядеть, для одной переменной понятно. А как матрица для нескольких переменных будет выглядеть. Не могу разобраться

http://www.ibss.iuf.net/marecol/52/21.htm
Решение такой задачи только МНК

Alex1984

Дата 18.5.2006, 09:55 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 299
Регистрация: 6.3.2005
Где: Киев

Репутация: нет
Всего: 2

Код


program ya;
uses crt;
type matr=array[1..10,1..10] of real;
type matr1=array [1..10] of real;
var
z,f,e:matr1;
i,j,m,n:integer;
b,y,x:matr;
k:matr1;
a: array[1..15,1..15,1..15] of real;

function mines(q:integer):integer;
begin
if (q/2=trunc(q/2)) then mines:=1 else mines:=-1;
end;

function determ(m:matr; r:integer):real;
  var f:real;
  i,j:integer;

Function matrix(w:matr; e,c:integer):real;
  var p,u,v:integer;
begin
       for u:=e to c-1 do
       for v:=1 to c do w[u,v]:=w[u+1,v];
       for p:=1 to c-1 do
       for v:=1 to c do w[v,p]:=w[v,p+1];
       matrix:=determ(w,c-1);
  end;
  begin
  if r=1 then determ:=m[1,1]
  else
      begin
      f:=0;
      for i:=1 to r do
          f:=f+mines(i+1)*matrix(m,i,r)*m[i,1];
      determ:=f;
      end;
end;

procedure reshenie(k:matr; o:matr1);
var
   d:real;
   h:matr;
   q,w:integer;
begin
h:=k;
d:=determ(k,4);
for j:=1 to 4 do
    begin
    k:=h;
    for i:=1 to 4 do
        k[i,j]:=o[i];
        e[j]:=determ(k,4)/d;
    end;
end;


BEGIN
clrscr;
Writeln('Vvedite koli4estvo to4ek');
readln(n);
writeln('Vvedite vektor X');
for i:=1 to n do
    begin
    write('X[',i,']=');
    readln(x[i,1]);
    end;
writeln('Vvedite vektor Y');
for i:=1 to n do
    begin
    write('Y[',i,']=');
    readln(x[i,2]);
    end;
    writeln('Vvedite vektor Z');
for i:=1 to n do
    begin
    write('Z[',i,']=');
    readln(x[i,3]);
    end;
writeln('Vvedite zna4enie funkcii v to4kah');
for i:=1 to n do
    begin
    write('to4ka',i,'=');
    readln(f[i]);
    end;


WriteLn;
     For I := 1 To N Do Begin
         For J := 1 To N Do Write(x[I,J]:5:2,'  ');
         WriteLn;
     End;


for i:=1 to n do
begin
a[1,1,i]:=x[i,1]*x[i,1];
a[1,2,i]:=x[i,1]*x[i,2];
a[1,3,i]:=x[i,1]*x[i,3];
a[1,4,i]:=x[i,1];

a[2,1,i]:=x[i,2]*x[i,1];
a[2,2,i]:=x[i,2]*x[i,2];
a[2,3,i]:=x[i,2]*x[i,3];
a[2,4,i]:=x[i,2];

a[3,1,i]:=x[i,3]*x[i,1];
a[3,2,i]:=x[i,3]*x[i,2];
a[3,3,i]:=x[i,3]*x[i,3];
a[3,4,i]:=x[i,3];

a[4,1,i]:=x[i,1];
a[4,2,i]:=x[i,2];
a[4,3,i]:=x[i,3];
a[4,4,i]:=1;


y[1,i]:=f[i]*x[i,1];
y[2,i]:=f[i]*x[i,2];
y[3,i]:=f[i]*x[i,3];
y[4,i]:=f[i]*x[i,4];
end;

     For I := 1 To N Do Begin
         For J := 1 To 3 Do Write(x[I,J]:5:2,'  ');
         WriteLn;
     End;
     for m:=1 to n do
     begin
     For I := 1 To 4 Do Begin
         For J := 1 To 4 Do Write(a[I,J,m]:5:2,'  ');
         WriteLn;
     End;
     writeln;
     end;
for m:=1 to n do
    for i:=1 to 4 do
    begin
        for j:=1 to 4 do begin
            b[i,j]:=a[i,j,m]+b[i,j];
            k[j]:=k[j]+y[i,j];
            end;
    end;
     For I := 1 To 4 Do Begin
         For J := 1 To 4 Do Write(b[I,J]:7:2,'  ');
         WriteLn;
     End;


reshenie(b,k);

writeln(e[2]:5:2,'x+',e[3]:5:2,'y+',e[4]:5:2,'z+',e[1]:5:2);
readkey;

END.

но не работает smile

А что тут не так?

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »