- Delphiartiklar, tips, forum, länksamling - 

      

START | DELPHI | LÄNKARGÄSTBOK 




 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: 1425
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; 

 
 
© Copyright 2005 - Staffan Berg
- Alla rättigheter förbehålles -