фyнкция: аппpоксимация &Co
- From
- Alex Malashonok (2:4635/83.64)
- To
- Yuri Burger
- Date
- 2002-06-22T01:17:56Z
- Area
- RU.ALGORITHMS
Привет Yuri!
Вторник Июнь 18 2002 18:29, Yuri Burger -> Alex Malashonok:
KP>>>> Люди, если дано f(x1)=y1, f(x2)=y2 .... f(xn)=yn, можно ли найти
KP>>>> фyнкцию???
YB>>> Ваpианты: Cтатиcтика, Полиномы, Нейpонные cети, Метод
YB>>> гpyппового yчета аpгyментов (МГУА), тепеpь еще и
YB>>> Тpанcпониpованная pегpеccия.
AM>> + Фильтpы _?Габбеpа?_ - Рyллезнейшие pезyльтаты! (нy для фyнкций
YB> Делиcь опиcанием/cыpцами ;)
Суть метода: имеется таблица зависимостей Y от X (или от нескольких параметров - X1,X2,...) - экспериментальные данные. Выбираем модель зависимостей параметров (совсем произвольно, но от этого зависит точность):
напр. Yi = a0 + a1*xi1 + a2*xi2 + a3*xi1*xi2 + a4*xi1^2 + a5*xi2^2
(т.наз. квадратичная модель)
Модель выбирается для того, чтобы определить, какой из параметров больше влияет на интерполируемою функцию:
напр. в нашей квадратичной модели по ходу вычислений напр. получается
a0 = 23.333
a1 = -3.112
a2 = 0.2344
a3 = 1.949
a4 = -34.234
a5 = 3.344
Это говорит о том, что на функцию в большей мере зависит от квадрата xi1, и в меньшей мере зависит от хi2.
ну это я забежал вперед :). После того, как мы выбрали модель у нас есть неизвестные параметры a0,a1, ..., a5, и куча уравнений - т.е. имеем переопределенную матрицу в которой 6 переменных и Nэксперементов строк:
1 x1_1 x1_2 x1_1*x1_2 x1_1*x1_1 x1_2*x1_2 | Y1
1 x2_1 x2_2 x2_1*x2_2 x2_1*x2_1 x2_2*x2_2 | Y2
1 x3_1 x3_2 x3_1*x3_2 x3_1*x3_1 x3_2*x3_2 | Y3
....................................................... | ...
Системма должна быть не _недоопределенной_ (Понятно почему:).
Далее нормализируем эту системму (см. исх. текст), и решаем методом гаусса.
that's all...
Вот сырок. Что делает программа - ей на вход подается таблично заданная функция (в данном случае tg), далее системма "обучается" (т.е. нормализируется), и на выходе получаем многочлен в виде выбранной нами модели. Многочлену на вход дается вектор предыдущих значений функции, по которым находится следующее значение: Ynext = P(Ylast, Ylastlast)
ps. Переделайте Гаусса (я не делал поиск вед. элемента).
=== File <GABBER.PAS> { ===
const
n = 30;
ModelLen = 5;
var
v: array[1..n] of extended;
var
k: array[0..ModelLen,1..n-2] of extended;
l: array[1..n-2] of extended;
k_n: array[0..ModelLen,0..ModelLen] of extended;
l_n: array[0..ModelLen] of extended;
procedure fillk;
var
i: integer;
begin
for i := 3 to n do
begin
k[0,i-2] := 1;
k[1,i-2] := v[i-2];
k[2,i-2] := v[i-1];
k[3,i-2] := sqr(v[i-2]);
k[4,i-2] := sqr(v[i-1]);
k[5,i-2] := v[i-1]*v[i-2];
l[i-2] := v[i];
end;
end;
procedure showv;
var
i: integer;
begin
writeln('Эксперементальные значения:');
for i:=1 to n do writeln('y(',i,'*pi/20+pi/34)=',v[i]:10:6);
writeln;
end;
procedure showk;
var
i,j : integer;
begin
for j:=1 to n-2 do begin
write('|');
for i:=0 to ModelLen do
write(k[i,j]:10:4);
writeln('|');
end;
end;
procedure showk_n;
var
i,j : integer;
begin
for j:=0 to ModelLen do begin
write('|');
for i:=0 to ModelLen do
write(k_n[i,j]:8:3);
writeln('| | ',l_n[j]:6:3,' |');
end;
end;
procedure normalize;
var
i,j,e: integer;
sum: extended;
begin
for e := 0 to ModelLen do begin
for i := 0 to ModelLen do
begin
sum := 0;
for j := 1 to n-2 do
sum := sum + k[e,j]*k[i,j];
k_n[i,e] := sum/(n-2);
end;
sum := 0;
for j := 1 to n-2 do
sum := sum + l[j]*k[e,j];
l_n[e] := sum/(n-2);
end;
end;
type arra = array[0..ModelLen,0..ModelLen] of extended;
arrb = array[0..ModelLen] of extended;
procedure Gauss(a: arra;b: arrb;var x: arrb);
var
t: arra;
r: arrb;
i,j,e: integer;
c: extended;
begin
move(a,t,sizeof(a));
move(b,r,sizeof(b));
for i :=0 to ModelLen-1 do
for j :=i+1 to ModelLen do
begin
c := -t[i,i]/t[i,j];
for e:=0 to ModelLen do
begin
t[e,j] := t[e,i] + c*t[e,j];
end;
r[j] := r[i]+c*r[j];
end;
x[ModelLen] := r[ModelLen]/t[ModelLen,ModelLen];
for i := ModelLen-1 downto 0 do
begin
c := r[i];
for j := i+1 to ModelLen do
c := c-x[j]*t[j,i];
x[i] := c/t[i,i];
end;
end;
var
a: arrb;
i: integer;
function func(q,w: extended): extended;
begin
func := a[0] + a[1]*q + a[2]*w + a[3]*q*q + a[4]*w*w + a[5]*q*w;
end;
function tan(t: extended): extended;
begin
tan := sin(t)/cos(t);
end;
var
t,l1,l2,l3: extended;
r,w,e: integer;
rl: array[1..20] of extended;
begin
t := pi/34;
for r:=1 to n do
begin
v[r] := tan(15*t);
t := t + pi/20;
end;
for r:=1 to 20 do
begin
rl[r]:= tan(15*t);
t := t + pi/20;
end;
showv;
fillk;
readln;
writeln;
writeln('Генерируем модели:');
showk;
readln;
normalize;
writeln('Нормализируем:');
showk_n;
Gauss(arra(k_n),arrb(l_n),arrb(a));
writeln;
readln;
writeln('Находим методом Гаусса параметры: ');
for i:=0 to ModelLen do
write('a',i,'=',a[i]:1:4,' ');
writeln;
writeln('Проверяем насколько близка полученная модель к реальности:');
l2 := 0;
for i:=1 to n-3 do begin
t := func(v[i],v[i+1]);
l1 := sqr(abs(v[i+2]-t));
l2 := l2 + l1;
writeln('Func(',v[i]:6:3,',',v[i+1]:6:3,')=',t:9:6,' | ',v[i+2]:9:6,' | ',l1:9:6);
end;
writeln(l2/(n-2));
readln;
writeln;
writeln('Прогнозируем 20 раз:');
l1:=v[n-1];
l2:=v[n];
for i:=1 to 20 do
begin
t := func(l1,l2);
writeln('Func(',l1:6:3,',',l2:6:3,')=',t:9:6,' | ',rl[i]:9:6,' | ',abs(rl[i]-t):9:6);
l1:=l2;
l2:=t;
end;
end.
=== } GABBER.PAS ===
Alex
--- Советую стереть эту строку...
* Origin: Допиши свой ориджин :) (2:4635/83.64)