Cod sursa(job #872941)

Utilizator Dddarius95Darius-Florentin Neatu Dddarius95 Data 6 februarie 2013 19:12:54
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.25 kb
program a11;
type vect=array[0..100]of real;
var i,j,n:integer;
    x1,x2,x3,p:real;
    a,t,y,z,f:vect;
    g,h:text;
begin
assign(g,'a1.out');rewrite(g);
assign(h,'a1.in');reset(h);
readln(h,n);
for i:=0 to n do readln(h,a[i]);
readln(h,x1,x2,x3);
for i:=0 to n do write(a[i],' ');
p:=(x2-x1)/66;
for i:=1 to 67 do begin
               y[i]:=x1+(i-1)*p;t[i]:=a[n];
               for j:=n-1 downto 0 do t[i]:=a[j]+y[i]*t[i];
               writeln(g,'t[',i,']=',t[i]:5:3);
               end;
for i:=1 to 67 do if (x3>y[i])and(x3<=y[i+1]) then
                  p:=t[i]*((x3-y[i+1])/(y[i]-y[i+1]))+t[i+1]*((x3-y[i])/(y[i+1]-y[i]));
p:=(t[67]-t[1])/6;
for i:=1 to 7 do z[i]:=t[1]+(i-1)*p;
for i:=1 to 6 do
  for j:=1 to 67 do if (t[j]>z[i])and(t[j]<z[i+1]) then f[i]:=f[i]+1;
writeln(g,'Coeficientii ecuatiei sunt:');
for i:=0 to n do writeln(g,'a[',i,']=',a[i]:5:3);
writeln(g,'x1=',x1:5:3);
writeln(g,'x2=',x2:5:3);
writeln(g,'x3=',x3:5:3);
writeln(g,'valorile functiei sunt:');
for i:=1 to 67 do writeln(g,'y[',i,']=',y[i]:5:3,' , t[',i,']=',t[i]:5:3);
writeln(g,'valoarea polinomului este:',p:5:3);
for i:=1 to 6 do
  writeln(g,'in intervalul ',z[i]:5:3,', ',z[i+1]:5:3,' avem o frecventa de ',f[i]:5:3,' valori ');
close(h);close(g);
end.