|
ru.algorithms
- RU.ALGORITHMS ----------------------------------------------------------------
From : Alex Malashonok 2:4635/83.64 22 Jun 2002 01:17:56
To : Yuri Burger
Subject : фyнкция: аппpоксимация &Co
--------------------------------------------------------------------------------
Вторник Июнь 18 2002 18:29, Yuri Burger -> Alex Malashonok:
KP>>>> Люди, если дано f(x1)=y1, f(x2)=y2 .... f(xn)=yn, можно ли найти
KP>>>> фyнкцию???
YB>>> Ваpианты: Cтатиcтика, Полиномы, Hей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('Hормализируем:');
showk_n;
Gauss(arra(k_n),arrb(l_n),arrb(a));
writeln;
readln;
writeln('Hаходим методом Гаусса параметры: ');
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)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
| Тема: |
Автор: |
Дата: |
|
фyнкция |
Kirill Pshinnik |
08 Jun 2002 17:50:51 |
 Re: фyнкция |
Alex Gorbatsevich |
08 Jun 2002 17:48:24 |
|
Re: фyнкция |
Andrei Bejenari |
09 Jun 2002 01:36:33 |
|
Re: функция |
Michael Ryazanov |
09 Jun 2002 01:35:00 |
 фyнкция |
Yuri Burger |
11 Jun 2002 12:20:37 |
 фyнкция |
Alex Malashonok |
16 Jun 2002 00:07:55 |
 фyнкция: аппpоксимация &Co |
Yuri Burger |
18 Jun 2002 18:29:06 |
 фyнкция: аппpоксимация &Co |
Alex Malashonok |
22 Jun 2002 01:17:56 |
|
Re: фyнкция |
Roman Ilyin |
17 Jun 2002 23:06:58 |
|
фyнкция |
Alex Malashonok |
22 Jun 2002 01:55:14 |
|
RE: фyнкция |
Anatoly Svishev |
27 Jun 2002 00:28:55 |
|
фyнкция |
Alexander Grischuk |
21 Jun 2002 14:56:42 |
|
|
