Форум: "Потрепаться";
Текущий архив: 2003.09.01;
Скачать: [xml.tar.bz2];

Вниз

Математическая библиотека.   Найти похожие ветки 

← →
dMikl   (2003-08-13 14:55) [0]

Уважаемые мастера!
Укажите где лежит (или вышлите на E-mail) программуську для аппроксимации полиномом по методу наименьших квадратов (с возможность автоматического выбора степени полинома).

---

← →
Семен Сорокин   (2003-08-13 15:02) [1]

может разберешься, в примерах валялось:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, ExtCtrls;

type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Image1: TImage;
SpeedButton1: TSpeedButton;
procedure SpeedButton1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
procedure Rect1(a,b: integer);
public
{ Public declarations }
end;

var
Form1: TForm1;
const n=7; {n+1 -

---

← →
Семен Сорокин   (2003-08-13 15:08) [2]

тьфу, комметны загадились :)), повторяю:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, ExtCtrls;

type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Image1: TImage;
SpeedButton1: TSpeedButton;
procedure SpeedButton1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
procedure Rect1(a,b: integer);
public
{ Public declarations }
end;

var
Form1: TForm1;
const n=7; {n+1 - число узловых точек }
m=4; {степень многочлена }
type Vect = array[0..n] of real;
Vect_M = array[0..m] of Real;
Matr = array[0..m,0..m] of Real;
const p=50; {число точек между узловыми точками }
a1=-1; a2=10; b1=-4; b2=10; {окно на бумаге }
{ координаты узловых точек }
x: Vect=(1.0,2.0,3.0,4.0,5.0,6.0,7.5,8.8);
y: Vect=(1.0,2.3,3.4,2.9,3.7,4.8,3.2,2.1);
var i: Byte; Gr,Gm: Integer;
I1,J1,I2,J2: integer; {окно на экране }
h, {шаг между узловыми точками }
u0,v0,u,v: Real; {x,y между узловыми точками }
c: Vect_M;

implementation

{$R *.DFM}

function II(x: real): integer;
begin
II:=I1+Trunc((I2-I1)*(x-a1)/(a2-a1));
end;

function JJ(y: real): integer;
begin
JJ:=J2+Trunc((J1-J2)*(y-b1)/(b2-b1));
end;

function F(m: Byte; x: Real; c: Vect_M): Real;
{Вычисление значения многочлена}
var i: Byte; y: Real;
begin
y:=0;
for i:=m downto 0 do y:=y*x+c[i];
F:=y;
end;

procedure Gauss(n,m: Byte; x,y: Vect; var c: Vect_m);
var A: Matr;
b: Vect_M;
i,j,k,l: Byte;
P: Real;
begin
{коэффициенты матрицы}
for j:=0 to m do
for k:=j to m do
begin
A[j,k]:=0;
for i:=0 to n do
begin
p:=1; for l:=1 to j+k do p:=p*x[i];
A[j,k]:=A[j,k]+P;
end;
A[k,j]:=A[j,k];
end;
{свободные члены}
for k:=0 to m do
begin
B[k]:=0;
for i:=0 to n do
begin
P:=y[i]; for l:=1 to k do P:=P*x[i];
B[k]:=B[k]+P;
end;
end;
{решение системы: прямой ход}
for i:=0 to m-1 do
for j:=i+1 to m do
begin
for k:=i+1 to m do
A[k,j]:=A[k,j]-A[i,j]*A[k,i]/A[i,i];
B[j]:=B[j]-B[i]*A[i,j]/A[i,i];
end;
{решение системы: обратный ход}
for j:=m downto 0 do
begin
c[j]:=B[j];
for k:=j+1 to m do c[j]:=c[j]-A[k,j]*c[k];
c[j]:=c[j]/A[j,j];
end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.Rect1(a,b: integer);
const c4=2;
begin
with Image1.Canvas do
RectAngle(a-c4,b-c4,a+c4,b+c4);
end;

procedure TForm1.FormActivate(Sender: TObject);
var i: integer;
begin
Gauss(n,m,x,y,c);
with Image1.Canvas do
begin
I1:=0; J1:=0; I2:=Width; J2:=Height; {окно на экране }
MoveTo(II(a1),JJ(0)); LineTo(II(a2),JJ(0));
MoveTo(II(0),JJ(b1)); LineTo(II(0),JJ(b2));
for i:=0 to n do Rect1(II(x[i]),JJ(y[i]));
{Построение графика функции}
h:=(x[n]-x[0])/p; u:=x[0]; v:=F(m,u,c);
MoveTo(II(u),JJ(v));
for i:=1 to p do
begin
u:=u+h; v:=F(m,u,c);
LineTo(II(u),JJ(v));
end;
end;
end;

end.

---

Страницы: 1 вся ветка

Форум: "Потрепаться";
Текущий архив: 2003.09.01;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.01 c