{Метод наименьших квадратов}
program Mnk;
uses crt; {модуль управления экраном}
type matrix=array[0..100,0..100] of real;
vector=array [0..100] of real; {Нумеруем точки с нуля}
var n,m,k,i:integer;
x,f,c:vector;
a:matrix;
x0,x9,h,x1:real;
procedure InputData (n:integer; var x,f:vector); {Ввод исходных данных}
begin
for i:=0 to n do begin
write ('Введите пару значений X(',i,'),F(',i,'):');
readln (x,f);
end;
end;
function ex (a:real; n:integer):real;
{Показательная функция для формирования матрицы Грама}
var i:integer;
e:real;
begin
e:=1;
for i:=1 to n do e:=e*a;
ex:=e;
end;
procedure Gram (n,m:integer; var x,f:vector; var a:matrix);
{Формирование матрицы Грама A по векторам данных X,F}
var i,j:integer;
p,q,r,s:real;
begin
for j:=0 to m do begin
s:=0; r:=0; q:=0;
for i:=0 to n do begin
p:=ex(x,j);
s:=s+p;
r:=r+p*f;
q:=q+p*ex(x,m);
end;
a[0,j]:=s;
a[j,m]:=q;
a[j,m+1]:=r;
end;
{Надо формировать только 1-ю строку и 2 последних столбца матрицы Грама,
остальные элементы легко получить циклическим копированием: }
for i:=1 to m do
for j:=0 to m-1 do a[i,j]:=a[i-1,j+1];
end;
procedure Gauss(n:integer; var a:matrix; var x:vector);
{Решение СЛАУ методом Гаусса}
{a - расширенная матрица системы, x - вектор результата}
var i,j,k,l,k1,n1:integer;
r,s:real;
begin
{Прямой ход: }
n1:=n+1;
for k:=0 to n do begin
k1:=k+1;
s:=a[k,k];
for j:=k1 to n1 do a[k,j]:=a[k,j]/s;
for i:=k1 to n do begin
r:=a[i,k];
for j:=k1 to n1 do a[i,j]:=a[i,j]-a[k,j]*r;
end;
end;
{Обратный ход: }
for i:=n downto 0 do begin
s:=a[i,n1];
for j:=i+1 to n do s:=s-a[i,j]*x[j];
x:=s;
end;
end;
function fi (m:integer; var c:vector; x1:real):real;
{Аппроксимирующая функция по найденным коэффициентам МНК}
{m - степень полинома, c - вектор коэффициентов,
x1 - точка, в которой ищем значение}
var i:integer; p:real;
begin
p:=c[m];
for i:=m-1 downto 0 do p:=c+x1*p;
fi:=p;
end;
begin
clrscr; {очистить экран}
writeln ('Подбор зависимости методом наименьших квадратов');
write ('Введите число узлов (1<n<100):');>:10:4);
writeln;
writeln ('Введите границы по оси X для построения полинома: ');
read (x0,x9);
writeln ('Введите шаг по X для построения значений полинома: ');
read (h);
k:=round((x9-x0)/h+1);
x1:=x0;
for i:=1 to k do begin
{строим и выводим полином по найденным коэффициентам}
writeln (x1:10:4,fi(m,c,x1):10:4);
x1:=x1+h;
end;
reset (input); readln;
end.
Другие языки программирования и технологии
РЕбят посмотрите програмку пожалуйста!На паскале, может кто поможет с решением!?
А где математика? Или за тебя еще и метод наименьших квадратов изучать по-быстрому?
Похожие вопросы
- Помогите написать 2 програмки на Турбо Паскале.
- Помогите с решением. Паскаль.
- люди добрые помогите мне написать программу в паскале, метод Рунге Кутта. Математическое решение есть у меня
- Задача по программированию Крестики-нолики ( Паскаль) . Помогите с решением, пожалуйста.
- Паскаль написать программу помогите. срочно. Пожалуйста
- Помогите пожалуйста с паскалем...я его только осваиваю(
- Помогите пожалуйста с паскалем!!!
- Нужно написать программы в Паскале! Массивы! Срочно! Помогите!
- помогите с решение задачи на Турбо паскале
- Помогите пожалуйста с паскалем!