Показать сообщение отдельно
Старый 13.10.2014, 17:52   #4 (permalink)
oleum
Новичок
 
Регистрация: 24.02.2014
Сообщений: 4
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

правильно делаю?
Код:
program Approks;
 uses crt;
label 1,2;
var
 m,i,j,n,k:integer;
 q,x,y,b,kof: array [0..30] of real;
 a: array [0..30,0..30] of real;
 s,r,c,v,e,func:real;
 BEGIN
 n:=19;
 x[0]:=1;      x[1]:=2;      x[2]:=3;      x[3]:=4;     x[4]:=5;     x[5]:=6;     x[6]:=7;     x[7]:=8;     x[8]:=9;     x[9]:=10;
 x[10]:=11;    x[11]:=12;    x[12]:=13;    x[13]:=14;   x[14]:=15;   x[15]:=16;   x[16]:=17;   x[17]:=18;   x[18]:=19;   x[19]:=20;
 y[0]:=-1.06;  y[1]:=-0.83;  y[2]:=-0.68;  y[3]:=-0.31; y[4]:=0.11;  y[5]:=0.00;  y[6]:=0.12;  y[7]:=0.53;  y[8]:=0.18;  y[9]:=0.25;
 y[10]:=0.38;  y[11]:=0.21;  y[12]:=0.44;  y[13]:=0.63; y[14]:=0.86; y[15]:=1.05; y[16]:=1.32; y[17]:=1.55; y[18]:=1.82; y[19]:=1.71;
  write('введите степень полинома N:');
  readln(m);
  for i:=0 to n do
  q[i]:=1;
  i:=0;
  repeat
             s:=0;
             r:=0;
             j:=0;
             1:
             if j>n then
              begin
               a[0,i]:=s;
               b[i]:=r;
              end
                    else
                     begin
                      s:=s+q[j];
                      r:=r+q[j]*y[j];  {Программа формирует матрицу}
                      q[j]:=q[j]*x[j];
                      j:=j+1;
                      goto 1;
                     end;
             i:=i+1;
   until i>m;
   i:=1;
   repeat
   s:=0;
   j:=0;
   2:
   if j>n then
    begin
     a[i,m]:=s;
     i:=i+1;
    end
          else
           if j<m then
            begin
             a[i,j]:=a[i-1,j+1];
             s:=s+q[j];
             q[j]:=q[j]*x[j];
             j:=j+1;
             goto 2;
            end
                   else
                    begin
                     s:=s+q[j];
                     q[j]:=q[j]*x[j];
                     j:=j+1;
                     goto 2;
                    end;
   until i>m;
   
   {решение СЛАУ методом Гаусса}
    for k:=0 to m do begin
   for i:=k+1 to m do  begin
   c:= (a[i,k])/(a[k,k]);
   a[i,k]:=0;
   for j:=k+1 to m do begin
   a[i,j]:=a[i,j]-a[k,j]*c;
   end;
   b[i]:=b[i]-b[k]*c;
   end;
   end;
   x[m]:=b[m]/a[m,m];
   for i:=m-1 downto 0 do begin
   v:=0;
   for j:=i+1 to m do begin
   v:=v+(a[i,j]*x[j]);
   end;
   x[i]:=(b[i]-v)/a[i,i];
   end;    
     for i:=m downto 0 do
      kof[i]:=x[i];                  
          for i:=m downto 0 do
     writeln('a',i,'= ',kof[i]:0:5);
    x[0]:=1;     x[1]:=2;     x[2]:=3;     x[3]:=4;     x[4]:=5;     x[5]:=6;     x[6]:=7;     x[7]:=8;     x[8]:=9;     x[9]:=10;
    x[10]:=11;   x[11]:=12;   x[12]:=13;   x[13]:=14;   x[14]:=15;   x[15]:=16;   x[16]:=17;   x[17]:=18;   x[18]:=19;   x[19]:=20;
   func:=0;
     e:=0;
      for j:= 0 to n do 
      func:=0;
 begin
  for i:=m downto 0 do
   func:=func+(power(x[j],i)*kof[i]);
   e:=e+(y[j]-func)*(y[j]-func);
  end;
 writeln('Погрешность= ', e:1:5);
end.
oleum вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070