Polynomial Interpolation

Neville's Algorithm

Neville's Algorithm -- The Functional Setting

nevilleF[values_,nodes_,level_,t_]:=If[Length[values]==1,values[[1]],nevilleF[Table[((nodes[[i+level]]-t)values[[i]]+(t-nodes[[i]]) values[[i+1]])/(nodes[[i+level]]-nodes[[i]]),{i,(Length[values]-1)}],nodes,(level+1),t]]

Linear

Manipulate[Module[{},Show[{ListPlot[{{1,a},{3,b}},Joined->False,PlotStyle->{Thickness[.007],PointSize[.04]}],Graphics[{{Thickness[.007],Line[{{1,0},{1,a }}]},{Thickness[.007],Line[{{3,0},{3,b }}]}}],Plot[nevilleF[{a,b},{1,3},1,t],{t,1,3},PlotStyle->If[interpolate,Thickness[.009],Thickness[.0000001]]]},Axes->True,ImageSize->250,AspectRatio->Automatic,PlotRange->{{-.5,4},{-1.5,4}}]],{{a,1},-1,4},{{b,2},-1,4},{interpolate,{False,True}},TrackedSymbols->{a,b,interpolate}]

Quadratic

Manipulate[Module[{},Show[{ListPlot[{{1,a},{3,b},{5,c}},Joined->False,PlotStyle->{Thickness[.007],PointSize[.04]}],Graphics[{{Thickness[.009],Line[{{1,0},{1,a }}]},{Thickness[.007],Line[{{3,0},{3,b }}],Line[{{5,0},{5,c }}]}}],Graphics[{Darker[Green],If[pl,Thickness[.008],Thickness[.0000001]],Line[{{1,a },{3,b},{5,c}}]}],Plot[nevilleF[{a,b,c},{1,3,5},1,t],{t,1,5},PlotStyle->If[smooth,Thickness[.009],Thickness[.0000001]]]},Axes->True,ImageSize->250,AspectRatio->Automatic,PlotRange->{{-.5,5.5},{-1.5,5.1}}]],{{a,4},-1,5},{{b,2},-1,5},{{c,4},-1,5},{smooth,{False,True}},{pl,{False,True}},TrackedSymbols->{a,b,c,smooth,pl}]

Quartic

Manipulate[Module[{},Show[{ListPlot[{{0,a},{1,b},{2,c},{3,d},{4,e}},Joined->False,PlotStyle->{Thickness[.007],PointSize[.04]}],Graphics[{{Thickness[.007],Line[{{0,0},{0,a }}]},{Thickness[.007],Line[{{1,0},{1,b }}]},{Thickness[.007],Line[{{2,0},{2,c }}]},{Thickness[.007],Line[{{3,0},{3,d }}]},{Thickness[.007],Line[{{4,0},{4,e }}]}}],Graphics[{Darker[Green],If[pl,Thickness[.008],Thickness[.0000001]],Line[{{0,a },{1,b},{2,c},{3,d},{4,e}}]}],Plot[nevilleF[{a,b,c,d,e},{0,1,2,3,4},1,t],{t,0,4},PlotStyle->If[smooth,Thickness[.009],Thickness[.0000001]]]},Axes->True,ImageSize->250,AspectRatio->Automatic,PlotRange->{{-.5,5},{-1.5,5}}]],{{a,1},-1,3},{{b,2},-1,3},{{c,3},-1,3},{{d,2},-1,3},{{e,2},-1,3},{smooth,{False,True}},{pl,{False,True}},TrackedSymbols->{a,b,c,d,e,smooth,pl}]

Manipulate[Module[{mytable=Table[{k,5(Sqrt[k])+(1/k)},{k,1,n}]},Show[{ListPlot[mytable,Joined->False,PlotStyle->{Thickness[.007],PointSize[.04/Log[n]]}],If[smooth,Plot[nevilleF[Table[mytable[[k,2]],{k,1,n}],Table[mytable[[k,1]],{k,1,n}],1,t],{t,1,n},PlotStyle->If[smooth,Thickness[.009],Thickness[.0000001]]],ListPlot[mytable,Joined->False,PlotStyle->{Thickness[.007],PointSize[.01]}]]},Axes->True,ImageSize->250,AspectRatio->Automatic,PlotRange->{{-.5,n+1},{-1.5,5(Sqrt[n])}}]],{smooth,{False,True}},{n,{8,16,32,64}},TrackedSymbols->{n,smooth}]

(2^8)
(2^16)
(2^32)
(2^64)

Fibonacci Numbers

Recursion

fib[0]=1;
fib[1]=1;

fib[n_]:=fib[n-1]+fib[n-2];

fib[30]

Fibonacci[100]

Iteration

Clear[fibnew];

fibnew[0]=1;
fibnew[1]=1;

fibnew[n_]:=Module[{},Do[fibnew[k]=fibnew[k-1]+fibnew[k-2],{k,2,n,1}];fibnew[n]]

fibnew[70]

Binomial Coefficients

Recursion

Clear[binom];

binom[m_,0]:=1;

binom[n_,k_]:=If[k>n,0,binom[n-1,k]+binom[n-1,k-1]];

binom[23,10]

Binomial[23,10]

Iteration

Clear[newbinom];

newbinom[n_,0]:=1;

newbinom[n_,k_]:=Module[{},If[k>n,newbinom[n,k]=0,Do[Do[newbinom[m,j]=newbinom[m-1,j-1]+newbinom[m-1,j],{j,1,k,1}],{m,1,n,1}]];newbinom[n,k]]

newbinom[23,10]

Binomial[23,10]