Function approximation explorations

Functions (& intervals) to test:

testcases={
{"A",Tanh,2π},
{"B",(((1+((Cos[#])^2)))^(-1))&,3π},
{"C",Exp[-((#)^2)]&,1 π},
{"D",If[((#)^2)<1,(1-((#)^2))Log[1-((#)^2)],0]&,1},
{"E",(((Exp[#]+1))^(-1))&,1},
{"F",If[((#)^2)<1,Exp[-(((1-((#)^2)))^(-1))],0]&,1},
{"G",Sin[((#)^2)]&,3 Sqrt[π]},
{"H",Sqrt[4-#]&,2}};

Define approximations:

Power series approximation: demand zero residual on M+1 equally spaced points across interval:

powerapprox[f_,l_,M_]:=Module[{indx=Range[0,M]},
grid=(2l/M)indx-l;
vals=f/@grid;
mtx=Transpose[If[#>0,(((grid/l))^(#)),1&/@grid]&/@indx];
coefs=LinearSolve[mtx,vals];
func[x,((((x/l))^(#))&/@indx).coefs]/.func->Function];

Fourier series approximation: demand zero residual on M+1 points with spacing 2l/(M+1), symmetric about zero.  M must be even:

fourierapprox[f_,l_,M_]:=Module[{indx=Range[-M/2,M/2]},
grid=(2l/(M+1))indx;
vals=f/@grid;
mtx=Transpose[(E^(I Pi# grid/l))&/@indx];
coefs=LinearSolve[mtx,vals]//FullSimplify;
func[x,((E^(I Pi # x/l))&/@indx).coefs]/.func->Function];

Chebyshev series approximation: demand zero residual on M+1 point Gauss-Lobatto (extrema plus endpoints) grid:

chebyapprox[f_,l_,M_]:=Module[{indx=Range[0,M]},
grid=-l Cos[# Pi/M]&/@indx;
vals=f/@grid;
mtx=Transpose[ChebyshevT[#,grid/l]&/@indx];
coefs=LinearSolve[mtx,vals]//Simplify;
func[x,(cheby[#,x/l]&/@indx).coefs]/.func->Function];
cheby[n_,x_?NumericQ]=ChebyshevT[n,x];

Test approximation by comparing to given function on finer grid:

maxerror[f_,g_,l_,M_]:=Module[{K=17M},
Max[Abs[f[#]-g[#]]&/@(2l/(K+1) Range[-K/2,K/2])]];

Report max error for all three approximations:

testerror[f_,l_,M_]:=Module[{},
maxerror[f,#[f,l,M],l,M]&/@{powerapprox,fourierapprox,chebyapprox}//N//Prepend[M]];

Sanity checks:

Does each approximation return the correct function for simple test cases:

powerapprox[((#)^4)&,3,8]
fourierapprox[Cos[2#]&,Pi,4]
%[x]//FullSimplify
chebyapprox[((#)^4)&,2,8]
%[x]/.cheby->ChebyshevT//Simplify

Run tests:

For each test case, make a table showing max errors for M = 8,...,64 in steps of 4.  (Multiply interval by 1.0 to force machine precision evaluation.)

byfours=Range[8,64,8];runtest[label_,f_,l_]:=result[label]=testerror[f,l,#]&/@byfours;

Do[Print[{label,f,l}=testcases[[i]]];Print[TableForm[runtest[label,f,1.0 l]]],
{i,1,Length[testcases]}]

Rerun, using extended precision:

Do[Print[{label,f,l}=testcases[[i]]];Print[TableForm[runtest[label,f,1`30 l]]],
{i,1,Length[testcases]}]

Summarize results:

assess=Which[
#>(10^(-2)),"Awful",
#>(10^(-3)),"So-So",
#>(10^(-6)),"Good ",
#>(10^(-9)),"VGood",
True,"Great"]&;
{#,assess/@Rest[Last[result[First[#]]]]}&/@testcases//TableForm[#,TableDepth->2]&

Function singularities?

Solve[1+((Cos[x])^2)==0,x]

Solve[(E^x)+1==0,x]