1) Interpolação usando pontos igualmente espa çados

\(
\(f[x_] := 1\/\(1 + x^2\)\ ;\)\ \)
a = -5;
b = 5;

Esboce o  gráfico da função f

\(\(\(
\)\(graficof = 
      Plot[f[x], {x, a, b}, 
        PlotStyle -> {Thickness[0.01], 
            RGBColor[1, 0, 0]}]\)\)\)

Considerando n+1 pontos igualmente espaçados no intervalo [-5,5] , 
determinar os polinómios interpoladores de f  (para n=5,10,16) 
comparando-os com a função.

\(\(\(
\)\( (*\ 
      Construção\ de\ tabelas\ com\ os\ valores\ das\ funções\ em\ n + 
        1\ pontos\ igualmente\ espaçados\ *) \)\)\)

tabf[n_] := 
        Table[{a + (b - a)*(i - 1)/n, 
            f[a + (b - a)*(i - 1)/n]}, {i, 1, n + 1}];

\(\(\(
\)\( (*\ 
      Construção\ dos\ polinómios\ interpoladores\ com\ base\ nas\ tabelas\ anteriores\ *) \)\)\)

Pf[n_] := InterpolatingPolynomial[tabf[n], t];

\(\(\(
\)\( (*\ 
      Construção\ dos\ gráficos\ dos\ polinómios\ interpoladores\ *) \)\)\)

\(grafPf[
        n_] := 
	{
		aux = Pf[n]; 
		Plot[aux /. t -> x, {x, a, b}, 
          PlotLabel -> SequenceForm["Pf[", n "]"]]
	}\)

(* 
      Gráfico dos pontos de interpolação *)

points[n_] := 
        ListPlot[tabf[n], PlotStyle -> PointSize[ .02]];

\(\(\(
\)\(Show[graficof, grafPf[5], points[5], 
      PlotLabel -> SequenceForm["n=5"]]\)\)\)

aux = Pf[5];
e[x_] := f[x] - (aux /. t -> x);
l = 
        Table[Abs[e[a + (b - a)*(i - 1)/200]], {i, 1, 
            200}];
Plot[Abs[e[x]], {x, a, b}, PlotRange -> All, 
        PlotLabel -> 
          SequenceForm["Função erro para n=5"]];
Print["O maximo do erro usando 200 pontos é: ", 
        Max[l]  // N];

\(\(\(
\)\(Show[graficof, grafPf[10], points[10], 
      PlotLabel -> SequenceForm["n=10"]]\)\)\)

aux = Pf[10];
e[x_] := f[x] - (aux /. t -> x);
l = 
        Table[Abs[e[a + (b - a)*(i - 1)/200]], {i, 1, 
            200}];
Plot[Abs[e[x]], {x, a, b}, PlotRange -> All, 
        PlotLabel -> 
          SequenceForm["Função erro para n=10"]];
Print["O maximo do erro usando 200 pontos é: ", 
        Max[l]  // N];

\(\(\(
\)\(Show[graficof, grafPf[16], points[16], 
      PlotLabel -> SequenceForm["n=16"]]\)\)\)

aux = Pf[16];
e[x_] := f[x] - (aux /. t -> x);
l = 
        Table[Abs[e[a + (b - a)*(i - 1)/200]], {i, 1, 
            200}];
Plot[Abs[e[x]], {x, a, b}, PlotRange -> All, 
        PlotLabel -> 
          SequenceForm["Função erro para n=16"]];
Print["O maximo do erro usando 200 pontos é: ", 
        Max[l]  // N];

2) No caso da função f repita a alínea anterior,  mas usando nós de Chebyshev em vez de pontos igualmente espa çados.

\(\(\(
\)\( (*\ 
      Cálculo\ dos\ zeros\ do\ polinómio\ de\ Chebyshev\ de\ grau\ n + 1\ *) \)\)\)

\(\(\(zero[n_, 
          k_] := \((b - a)\)*
            Cos[\((2*k + 1)\)/\((2*n + 2)\)*Pi]/2 + \((b + a)\)/
            2;\)\(
\)\)\)

\(\(\(
\)\( (*\ 
      Construção\ de\ uma\ tabela\ de\ valores\ de\ f\ nos\ nós\ de\ Chebyshev\ *) \)\)\)

\(\(\(
\)\(tabCf[n_] := 
        Table[{zero[n, k] // N, f[zero[n, k] // N]}, {k, 0, 
            n}];\)\)\)

\(\(\(
\)\( (*\ 
      Construção\ do\ polinómio\ interpolador\ de\ f\ sobre\ os\ nós\ de\ Chebyshev\ *) \)\)\)

PCf[n_] := N[InterpolatingPolynomial[tabCf[n], t]];

\(\(\(
\)\( (*\ 
      Grafico\ do\ polinómio\ interpolador\ sobre\ os\ nós\ de\ Chebyshev\ *) \)\)\)

\(grafPCf[
        n_Integer] := 
	{
		aux = PCf[n]; 
		Plot[aux, {t, a, b}, 
          PlotLabel -> SequenceForm["PCf[", n, "]"]]
	}\)

(* 
      Gráfico dos pontos de interpolação *)

pointsC[n_] := 
        ListPlot[tabCf[n], PlotStyle -> PointSize[ .02]];

Show[graficof, grafPCf[5], pointsC[5], 
      PlotLabel -> SequenceForm["n=5"]]

aux = PCf[5];
e[x_] := f[x] - (aux /. t -> x);
l = 
        Table[Abs[e[a + (b - a)*(i - 1)/200]], {i, 1, 
            200}];
Plot[Abs[e[x]], {x, a, b}, PlotRange -> All, 
        PlotLabel -> 
          SequenceForm["Função erro para n=5"]];
Print["O maximo do erro usando 200 pontos é: ", 
        Max[l]  // N];

Show[graficof, grafPCf[10], pointsC[10], 
      PlotLabel -> SequenceForm["n=10"]]

aux = PCf[10];
e[x_] := f[x] - (aux /. t -> x);
l = 
        Table[Abs[e[a + (b - a)*(i - 1)/200]], {i, 1, 
            200}];
Plot[Abs[e[x]], {x, a, b}, PlotRange -> All, 
        PlotLabel -> 
          SequenceForm["Função erro para n=10"]];
Print["O maximo do erro usando 200 pontos é: ", 
        Max[l]  // N];

\(\(\(
\)\(Show[graficof, grafPCf[16], pointsC[16], PlotRange -> All, 
      PlotLabel -> SequenceForm["n=16"]]\)\)\)

aux = PCf[16];
e[x_] := f[x] - (aux /. t -> x);
l = 
        Table[Abs[e[a + (b - a)*(i - 1)/200]], {i, 1, 
            200}];
Plot[Abs[e[x]], {x, a, b}, PlotRange -> All, 
        PlotLabel -> 
          SequenceForm["Função erro para n=16"]];
Print["O maximo do erro usando 200 pontos é: ", 
        Max[l]  // N];

Maneira alternativa para o cálculo do máximo do erro de  interpolação:

aux = PCf[16];
e[x_] := f[x] - (aux /. t -> x);
d[x_] := D[e[x], x];
l1 = x /. NSolve[d[x] == 0, x];
c1 = Length[l1];
l2 = List[];
\(\(For[i = 1, i <= c1, \(i++\), 
        If[\((Im[l1[\([i]\)]] == 0)\) && \((l1[\([i]\)] >= 
                a)\) && \((l1[\([i]\)] <= b)\), 

          l2 = Append[l2, Abs[e[l1[\([i]\)]]]]]];\)\)
Max[l2] // N

3) Ilustre a propriedade da norma mínima dos polinomios 
mónicos de Chebyshev

(no intervalo [-5,5])

\(\(\(tabesp[n_] := 
        Table[a + \((b - a)\)*\((i - 1)\)/n, {i, 1, 
            n + 1}];\)\(
\)\)\)

\(\(\(
\)\(\(p[n_]\)[x_] := 
        Product[\((x - \(tabesp[n]\)[\([i]\)])\), {i, 1, 
            n + 1}];\)\(
\)\)\)

\(\(\(
\)\(l[n_] := 
        Table[Abs[\(p[n]\)[a + \((b - a)\)*\((i - 1)\)/200\  // N]], {i, 1, 
            200}];\)\)\)

\(\(\(
\)\(plotw[n_] := 
        Plot[\(p[n]\)[x], {x, a, b}, 
          PlotLabel -> 
            SequenceForm["Max|W(x)| = ", 
              Max[l[n]] // N, \ " usando ", 
              n + 1, " nós"]];\)\)\)

Do[plotw[i], {i, 1, 9}]

\(\(
\)\( (*\ 
        Construção\ de\ uma\ lista\ dos\ n + 
          1\ nós\ de\ Chebyshev\ *) \)\)

\(\(\(
\)\(tabC[n_] := Table[zero[n, k] // N, {k, 0, n}];\)\)\)

\(\(\(\(p[n_]\)[x_] := 
        Product[\((x - \(tabC[n]\)[\([i]\)] // N)\), {i, 1, 
            n + 1}];\)\(
\)\)\)

\(\(\(
\)\(
\)\( (*\ 
      Calculo\ do\ maximo\ de\ W \((x)\)\ usando\ 200\ pontos\ *) \)\)\)

\(\(\(
\)\(l[n_] := 
        Table[Abs[\(p[n]\)[a + \((b - a)\)*\((i - 1)\)/200\  // N]], {i, 1, 
            200}];\)\)\)

\(\(\(
\)\(plotCw[n_] := 
        Plot[\(p[n]\)[x], {x, a, b}, 
          PlotLabel -> 
            SequenceForm["Max|W(x)| = ", 
              Max[l[n]] // N, \ " usando ", 
              n + 1, " nós"]];\)\)\)

Do[plotCw[i], {i, 1, 9}];

4) Calculo da constante C

Para os nós de Chebyshev

\(\(
 (*\ 
      Cálculo\ dos\ zeros\ do\ polinómio\ de\ Chebyshev\ de\ 
          grau\ n + 1\ *) \)\)

zero[n_, k_] := 
      (b - a)*Cos[(2*k + 1)/(2*n + 2)*Pi]/2 + (b + a)/2;

\(
 (*\ Construção\ de\ uma\ lista\ dos\ n + 
          1\ nós\ de\ Chebyshev\ *) \)

\(\(
\(tabC[n_] := Table[zero[n, k] // N, {k, 0, n}]; \)\)\)

\(\(\(\(p[n_]\)[x_] := 
      Product[\((x - \(tabC[n]\)[\([i]\)] // N)\), {i, 1, n + 1}]; \)
\)\)

\(\(
\(maxCh[n_] := 
      Max[Table[
          Abs[\(p[n]\)[a + \((b - a)\)*\((i - 1)\)/200\  // N]], {i, 1, 
            200}]]; \)\)\)

maxCh[15]

maxCh[25]

maxCh[35]

Para pontos igualmente espaçados

\(\(\(tabesp[n_] := Table[a + \((b - a)\)*\((i - 1)\)/n, {i, 1, n + 1}]; 
    \)
\)\)

\(\(
\(\(p[n_]\)[x_] := 
      Product[\((x - \(tabesp[n]\)[\([i]\)])\), {i, 1, n + 1}]; \)
\)\)

\(a1[n_] := \((a + b)\)/2 - \((b - a)\)/\((2*n)\); 

    b1[n_] := \((a + b)\)/2 + \((b - a)\)/\((2*n)\); \)

\(\(
\(maxEs[n_] := 
      Max[Table[
          Abs[\(p[n]\)[a1[n] + \((b1[n] - a1[n])\)*\((i - 1)\)/200\  // N]], {
            i, 1, 200}]]; \)\)\)

maxEs[15] // N

maxEs[25] // N

maxEs[35] // N

E^(Log[2*4.65661287307749827`*^6/95450.4839201341326`]/15) // N

E^(Log[2*4.44089209850063681`*^10/4.19447317059337532`*^7]/25) // N

E^(Log[2*4.23516473627165446`*^14/1.85258854039417482`*^10]/35) // N