Új hozzászólás Aktív témák

• #1092 tütüke tag

  Új Válasz 2006-04-21 12:37:53 #1092

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  tütüke

  tag

  Sziasztok!
  Egy jó nagy segitségre lenne szükségem. A feladat:
  Írjunk programot, amely grafikusan ábrázolja az interpolációs polinomot!
  
  Teszteljük a programot a következő adatokkal!
  (-10,6) ; (-7,-1) ; (-3,3) ; (0,0) ; (2,-6) ; (6,-1) ; (8,2) ; (10,7)
  
  Odáig megvan, hogy kiszámolja az értékeket, de a grafikus ábrázolás teljesen hiányzik.Ha valaki tud nekem segiteni, akkor nagyon megköszönném.
  Na ami megvan:
  
  program interpolacio;
  uses crt;
  var n,i,j,k:byte;
  s,t:real;
  a:array[1..20,1..20] of real;
  x,y:array[1..20] of real;
  sor:array[1..20] of byte;
  procedure olvas;
  begin
  clrscr;
  writeln('Interpol ci˘s polinom meghat roz sa');
  write('Kerem a t bl zatban szerepl‹ elemp rok sz m t(max 20): ');readln(n);
  writeln('K‚rem az ‚rt‚kp rokat!');
  for i:=1 to n do
  begin
  gotoxy(5,5+i);write('x[',i,'=');readln(x);
  gotoxy(18,5+i);write('y[',i,'=');readln(y);
  end
  end;
  procedure feltolt;
  begin
  for i:=1 to n do a[i,n+1]:=y;
  for i:=1 to n do
  for j:=n downto 1 do
  if j=n then a[i,j]:=1 else a[i,j]:=x*a[i,j+1];
  end;
  procedure csere;
  var seged:real;
  seged1:byte;
  l,m,h:byte;
  begin
  seged1:=sor;sor:=sor[j];sor[j]:=seged1;
  for l:=1 to n do
  begin seged:=a[l,i];a[l,i]:=a[l,j];a[l,j]:=seged end
  end;
  procedure rendez;
  var max:real;
  begin
  for i:=1 to n do sor:=i;
  for i:=1 to n-1 do
  begin
  max:=abs(a[i,i]);j:=i;
  for k:=i+1 to n do
  if abs(a[i,k])>max then begin max:=abs(a[i,k]);j:=k end;
  if j<>i then csere
  end
  end;
  procedure kiir;
  var v,j:byte;
  nincsere:boolean;
  s1:byte;
  s2:real;
  begin
  v:=n;
  repeat
  nincsere:=true;
  v:=v-1;
  for i:=1 to v do
  begin
  j:=i+1;
  if sor>sor[j] then begin s1:=sor;sor:=sor[j];sor[j]:=s1;
  s2:=a[i,n+1];a[i,n+1]:=a[j,n+1];a[j,n+1]:=s2;
  nincsere:=false end;
  end
  until (v=1) or nincsere;
  gotoxy(10,10);write('P(X)= ');
  for i:=1 to n do
  begin
  if (a[i,n+1] >0) and(i>1) then write('+');
  if a[i,n+1] <0 then write('-');
  
  if (a[i,n+1] <>0) and (abs(a[i,n+1])<>1) and(i<n) then
  write(abs(a[i,n+1]):5:2,'*');
  if (i<n) and (a[i,n+1]<>0) then begin write('X');
  if n-i>1 then begin gotoxy(wherex,wherey-1);
  write(n-i);gotoxy(wherex,wherey+1) end
  end
  else if a[i,n+1]<>0 then write(abs(a[i,n+1]):5:2)
  end;
  writeln
  end;
  procedure kikuszobol;
  var h,t:real;
  begin
  for i:=1 to n do
  begin
  h:=1/a[i,i];
  for k:=i to n+1 do
  a[i,k]:=a[i,k]*h;
  for j:=1 to n do
  if j<>i then begin t:=a[j,i];for k:=i+1 to n+1 do a[j,k]:=a[j,k]-t*a[i,k] end
  end
  end;
  
  begin
  olvas;feltolt;rendez;kikuszobol;clrscr;kiir;
  readln
  end.
  

Új hozzászólás Aktív témák