|
 Forum
Grundkurs
»Introduktion
»Snabbguide
»Komponenter
»Händelser
»Strängar
»Räkna med Delphi »Egna
typer
»Selektion
»Iteration
»Menyer
»Funktioner
»Arraystrukturer
Tips & Tricks
»Nya tips
»Blandat
»Databaser
»Filer
»Forms
»Grafik
»Internet
»Komponenter
»Matematik
»Multimedia
»Objekt/ActiveX
»Skrivare
»Strängar
»System
»Mest lästa tips
Artiklar
»Delphi och ADO
»Bygga en DLL
»Skapa en enkel rapport
»Hantera registret
»Enheter, units
»Klassen TCanvas
»Använd LookUp Controls
 Nya
tips
 Lägg
till tips
 Delphilänkar
 Gästbok
|
|
|
|
|
|
Beräkna polynom(trendlinje)
|
Kategori: Matematik
Inlagt: 2006-01-01
Läst: 1418
Inlagt av: Arne B
|
|
Beskrivning |
|
Beräknar polynom y=a+b*x+c*X^2+d*x^3.......... från en tabell med xy-värden
|
|
Kod |
type
Real array = array[0..100] of Double;
procedure Polynom(x,y : Realarray;antpar,maxgrad : Integer; var pkoef : RealArray);
{x,y tabell; antpar=tabellängd; maxgrad=gradtal polynom;pkoef=polynom koefficenterna}
var
a : array[0..16,0..25] of Double;
sumx : array[0..33] of Double;
sumy : array[0..16] of Double;
c : Double;
k,i,deg,j : Integer;
function PowRI(base: Double; exponent: Integer): Double;
{PowRI (a,b) -> a^b}
var r,pow : Double;
i : Integer;
begin
if exponent < 0 then
begin
r:= 1/base;
exponent:= -exponent;
end
else r:= base;
if Odd(exponent) then pow:= r
else pow:= 1.0;
exponent:= exponent DIV 2;
WHILE exponent > 0 DO
begin
r:= Sqr(r); (* kvadrera *)
if Odd(exponent) then pow:= pow*r;
exponent:= exponent DIV 2;
end;
PowRI:= pow;
end; (* PowRI *)
begin
for i:=0 to 33 do (*nollställ sumx*)
sumx[i]:=0.0;
for i:=0 to 16 do (* nollställ sumy *)
sumy[i]:=0.0;
for i:=0 to 15 do (*nollställ pkoef*)
pkoef[i]:=0.0;
(* Beräkna matriselementen a[i,j] *)
for i:=1 to antpar do begin
sumx[1]:=sumx[1]+1.0;
sumx[2]:=sumx[2]+x[i];
sumx[3]:=sumx[3]+x[i]*x[i];
sumy[1]:=sumy[1]+y[i];
sumy[2]:=sumy[2]+x[i]*y[i];
end;
for deg:=1 to maxgrad do begin
for i:=1 to deg+1 do begin
for j:=1 to deg+1 do
a[i,j]:=sumx[j-1+i];
a[i,deg+2]:=sumy[i];
end;
for i:=1 to deg+1 do begin
a[deg+2,i]:=-1.0;
for j:=i+1 to deg+2 do begin
a[deg+2,j]:=0.0;
end;
c:=1.0/a[1,i];
for k:=2 to deg+2 do begin
for j:=i+1 to deg+2 do
a[k,j]:=a[k,j]-a[1,j]*a[k,i]*c;
end;
for k:=1 to deg+1 do begin
for j:=i+1 to deg+2 do
a[k,j]:=a[k+1,j];
end;
end;
IF (maxgrad > deg) THEN begin
k:=deg+1;
j:=2*k;
sumx[j]:=0.0;
sumx[j+1]:=0.0;
sumy[k+1]:=0.0;
for i:=1 to antpar do begin
sumx[j]:=sumx[j]+PowRI(x[i],(j-1));
sumx[j+1]:=sumx[j+1]+PowRI(x[i],j);
sumy[k+1]:=sumy[k+1]+y[i]*PowRI(x[i],k);
end;
end;
end;
deg:=maxgrad+1;
for i:=1 to deg do
pkoef[i-1]:=a[i,deg+1]
end;
|
|
|