Помощь - Поиск - Пользователи - Календарь
Полная версия: Метод наименьших квадратов
Форум «Всё о Паскале» > Delphi, Assembler и другие языки. > Другие языки
anna
Помогите пожалуйста)))) Задание: Методом наименьших квадратов решить уравнение x^3 – x^2 – 4^x +4 = 0 с точностью 10^-5. проги есть, но куда и как это все вставить я не могу разобраться. Проги работают в паскаль абц.

program mnk;
uses crt;
var {Mx:Array[0..8] of integer;}Mx,My,Mz:array[0..7] of real;
i,j:integer;
A,B,k:real;

x1,x2,y1,y2,y3,r:real;
q1,q2,q3,q4,q5:real;

function ff(x:real;a:real;b:real):real;
var fun:real;
begin
fun:=a*(1/x)+b;
ff:=fun;
end;

begin
clrscr;

  Mx[0]:=3.80;   My[0]:=-21.41;
  Mx[1]:=0.25;   My[1]:=-9.9;
  Mx[2]:=0.48;   My[3]:=1.14;
  Mx[3]:=5.78;   My[4]:=-12.04;
  Mx[4]:=4.91;   My[5]:=-19.23;
  Mx[5]:=1.56;   My[6]:=-0.3;
  Mx[6]:=0.92;   My[2]:=11.26;
  Mx[7]:=5.73;   My[7]:=-19.56;

  for i:=0 to 7 do
  begin
  writeln('x[',i+1,']=',Mx[i] : 2 : 2,' ','y[',i+1,']=',My[i] : 2 : 2);
  end;

  for i:=0 to 7 do
  begin
  x1:=x1+Mx[i];
  x2:=x2+(Mx[i]*Mx[i]);
  y1:=y1+1/(My[i]*Mx[i]);
  y2:=y2+1/(My[i]);
  k:=k+((Mx[i])*(1/My[i]));
  end;
  A:=(8*k-k)/(8*x2-x2);
  B:=(y2-A*x1)/8;
  for i:=0 to 7 do
  begin Mz[i]:=ff(Mx[i],a,b);writeln(mz[i]);end;
  for i:=0 to 7 do
  y3:=y3+(Mz[i]-My[i])*(Mz[i]-My[i]);
  for i:=0 to 7 do
  begin
  q1:=q1+(Mx[i]-x1/8);
  q2:=q2+ff(Mx[i],a,b);
  q3:=q3+sqr((Mx[i]-q1/8));
  end;
  for i:=0 to 7 do
  begin
  q4:=q4+sqr(ff(Mx[i],a,b)-q2/8);
  q5:=q5+(ff(Mx[i],a,b)-q2/8);
  end;
  r:=q1*q5/sqrt(q3*q4);

  writeln('a=',a:2 :5,' ','b=',b:2 :5);
  writeln('Коэффицент корреляции равен=',' ', y3:2 :2);
  writeln('Сумма квадратов отклонений =',' ', r:0:2);

  for i:=0 to 7 do
  writeln('x[',i+1,']=',Mx[i]:2 :2,' ','z[',i+1,']=',mz[i]:2 :2);
  readln;
  end.

и еще одна

{Метод наименьших квадратов}
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[i],f[i]);
 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[i],j);
   s:=s+p;
   r:=r+p*f[i];
   q:=q+p*ex(x[i],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[i]:=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[i]+x1*p;
 fi:=p;
end;
 
begin
 clrscr; {очистить экран}
 writeln ('Подбор зависимости методом наименьших квадратов');
 write ('Введите число узлов (1<n<100):');
 read (n);
 n:=n-1; {нумерация будет с нуля!}
 write ('Введите степень полинома (1<=m<=',n,'):');
 read (m);
 InputData (n,x,f); {вводим данные}
 Gram (n,m,x,f,a); {считаем матрицу Грама}
 Gauss (m,a,c); {решаем систему линейных уравнений}
 
 writeln ('Коэффициенты полинома МНК ',m,' степени:');
 for i:=0 to m do write (c[i] : 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;
end.
!!FPA!!
Anna, думаю, что в приведённом условии задачи присутствует ошибка. МНК не для решения уравнений, а для нахождения вида функции по набору экспериментальных данных (x, y). Для решения уравнений используются другие методы - касательных, хорд, метод Ньютона и др.
Уточни условие и постарайся привести собственные попытки решения...
anna
Спасибо, впринципе я об этом знала, просто не очень хорошо в этом понимаю и решила уточнить. Подскажите еще в этом же задании для того же уравнения надо написать программу "линейная и квадратичная аппроксимация" это тоже не возможно?) Заранее спасибо))
!!FPA!!
Лучше полностью озучить само задание.

Решение уравнения - это нахождение одного или нескольких значений x, при которых уравнение превращается в тождество.

Аппроксимация - это нахождение функции (вида и коэффициентов), которая сколь угодно близко проходит к экспериментально найденным точкам.

В общем, чтобы к этому уравнению применить МНК, нужно изрядно пофантазировать как получить набор (x,y). Или прочесть задание.

А так можно напредполагать варианты получения пар (x,y).
Ну, например, взять несколько x из дапазона [a, b], вычислить несколько y=f(x)=x^3 – x^2 – 4^x +4, получим набор пар (x,y) и его и аппроксимируем линейной или квадратичной функцией.
Но это не будет решением задачи.
anna
Спасибо)) все поняла))
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.