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)

7*8
15*16
31*32
63*64

IQ TESTS

nevilleF[{6,6,6,6,6,6},{1,2,3,4,5,6},1,7]

nevilleF[{4, 7, 10 ,13, 16, 19},{1,2,3,4,5,6},1,7]

nevilleF[{3, 13, 29, 51, 79, 113},{1,2,3,4,5,6},1,7]

nevilleF[{2, 3, 12, 35, 78, 147},{1,2,3,4,5,6},1,7]

nevilleF[{1,2,4,8,16,32},{1,2,3,4,5,6},1,7]

{6,6,6,6,6,6};

Manipulate[Module[{mytable={{1,6}, {2,6}, {3,6}, {4,6}, {5,6}, {6,6}}},Show[Graphics[{If[smooth,PointSize[.06],PointSize[.00001]],Blue,Point[{7,nevilleF[{6,6,6,6,6,6},{1,2,3,4,5,6},1,7]}]}],{ListPlot[mytable,Joined->False,PlotStyle->{Thickness[.007],PointSize[.04]}],If[smooth,Plot[nevilleF[Table[mytable[[k,2]],{k,1,6}],Table[mytable[[k,1]],{k,1,6}],1,t],{t,1,7},PlotStyle->If[smooth,Thickness[.009],Thickness[.0000001]]],ListPlot[mytable,Joined->False,PlotStyle->{Thickness[.007],PointSize[.01]}]]},Axes->True,ImageSize->250,AspectRatio->Automatic,PlotRange->{{-.5,8},{0,10}}]],{smooth,{False,True}},TrackedSymbols->{smooth}]

{4, 7, 10 ,13, 16, 19};

Manipulate[Module[{mytable={{1,4}, {2,7}, {3,10}, {4,13}, {5,16}, {6,19}}},Show[Graphics[{If[smooth,PointSize[.06],PointSize[.00001]],Blue,Point[{7,nevilleF[{4, 7, 10 ,13, 16, 19},{1,2,3,4,5,6},1,7]}]}],{ListPlot[mytable,Joined->False,PlotStyle->{Thickness[.007],PointSize[.04]}],If[smooth,Plot[nevilleF[Table[mytable[[k,2]],{k,1,6}],Table[mytable[[k,1]],{k,1,6}],1,t],{t,1,7},PlotStyle->If[smooth,Thickness[.009],Thickness[.0000001]]],ListPlot[mytable,Joined->False,PlotStyle->{Thickness[.007],PointSize[.01]}]]},Axes->True,ImageSize->250,AspectRatio->Automatic,PlotRange->{{-.5,15},{0,25}}]],{smooth,{False,True}},TrackedSymbols->{smooth}]

{3, 13, 29, 51, 79, 113};

Manipulate[Module[{mytable={{1,3}, {2,13}, {3,29}, {4,51}, {5,79}, {6,113}}},Show[Graphics[{If[smooth,PointSize[.06],PointSize[.00001]],Blue,Point[{7,nevilleF[{3, 13, 29, 51, 79, 113},{1,2,3,4,5,6},1,7]}]}],{ListPlot[mytable,Joined->False,PlotStyle->{Thickness[.007],PointSize[.04]}],If[smooth,Plot[nevilleF[Table[mytable[[k,2]],{k,1,6}],Table[mytable[[k,1]],{k,1,6}],1,t],{t,1,7},PlotStyle->If[smooth,Thickness[.009],Thickness[.0000001]]],ListPlot[mytable,Joined->False,PlotStyle->{Thickness[.007],PointSize[.01]}]]},Axes->True,ImageSize->250,AspectRatio->1,PlotRange->{{-.5,10},{0,160}}]],{smooth,{False,True}},TrackedSymbols->{smooth}]

{2, 3, 12, 35, 78, 147};

Manipulate[Module[{mytable={{1,2}, {2,3}, {3,12}, {4,35}, {5,78}, {6,147}}},Show[Graphics[{If[smooth,PointSize[.06],PointSize[.00001]],Blue,Point[{7,nevilleF[{2, 3, 12, 35, 78, 147},{1,2,3,4,5,6},1,7]}]}],{ListPlot[mytable,Joined->False,PlotStyle->{Thickness[.007],PointSize[.04]}],If[smooth,Plot[nevilleF[Table[mytable[[k,2]],{k,1,6}],Table[mytable[[k,1]],{k,1,6}],1,t],{t,1,7},PlotStyle->If[smooth,Thickness[.009],Thickness[.0000001]]],ListPlot[mytable,Joined->False,PlotStyle->{Thickness[.007],PointSize[.01]}]]},Axes->True,ImageSize->250,AspectRatio->1,PlotRange->{{-.5,10},{0,250}}]],{smooth,{False,True}},TrackedSymbols->{smooth}]

{1, 2, 4, 8, 16, 32};

Manipulate[Module[{mytable={{1,1}, {2,2}, {3,4}, {4,8}, {5,16}, {6,32}}},Show[Graphics[{If[smooth||exp,PointSize[.06],PointSize[.00001]],Blue,Point[{7,nevilleF[{1, 2, 4, 8, 16, 32},{1,2,3,4,5,6},1,7]}]}],{ListPlot[mytable,Joined->False,PlotStyle->{Thickness[.007],PointSize[.04]}],If[smooth,Plot[nevilleF[Table[mytable[[k,2]],{k,1,6}],Table[mytable[[k,1]],{k,1,6}],1,t],{t,1,7},PlotStyle->If[smooth,Thickness[.009],Thickness[.0000001]]],ListPlot[mytable,Joined->False,PlotStyle->{Thickness[.007],PointSize[.01]}]],Plot[(2^(x-1)),{x,0,7},PlotStyle->{Red,If[exp,Thickness[.009],Thickness[.0000001]]}]},Axes->True,ImageSize->250,AspectRatio->1,PlotRange->{{-.5,10},{0,70}}]],{smooth,{False,True}},{exp,{False,True}},TrackedSymbols->{exp,smooth}]

{1,1, 2, 3,5, 8, 13};

nevilleF[{1,1, 2, 3,5, 8, 13},{1,2,3,4,5,6,7},1,8]

Manipulate[Module[{mytable={{1,1}, {2,1}, {3,2}, {4,3}, {5,5}, {6,8},{7,13}}},Show[Graphics[{If[smooth||exp,PointSize[.06],PointSize[.00001]],Blue,Point[{8,nevilleF[{1,1, 2, 3,5, 8, 13},{1,2,3,4,5,6,7},1,8]}]}],{ListPlot[mytable,Joined->False,PlotStyle->{Thickness[.007],PointSize[.04]}],If[smooth,Plot[nevilleF[Table[mytable[[k,2]],{k,1,7}],Table[mytable[[k,1]],{k,1,7}],1,t],{t,1,8},PlotStyle->If[smooth,Thickness[.009],Thickness[.0000001]]],ListPlot[mytable,Joined->False,PlotStyle->{Thickness[.007],PointSize[.01]}]]},Axes->True,ImageSize->250,AspectRatio->1,PlotRange->{{-.5,10},{0,30}}]],{smooth,{False,True}},TrackedSymbols->{smooth}]

Fibonacci Numbers

Recursion

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

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

fib[5]

Fibonacci[40]

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[20,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]