Adaptive Quadrature

Here is a function we wish to integrate.  Notice from its plot that it has a lot of wiggles near the origin.

f[x_]=Sin[(1/x)];
Plot[f[x],{x,0.05,1}]

Here we set up the recursive procedure that computes the integral using the adaptive quadrature technique.

S[a_,b_]=(1/6) (b-a) (f[a]+4 f[((a+b)/2)]+f[b]);

integ[a_,b_,tol_]:=
	If[N[Abs[S[a,b]-S[a,((a+b)/2)]-S[((a+b)/2),b]]<10 tol],
		N[S[a,((a+b)/2)]+S[((a+b)/2),b]],
		integ[a,((a+b)/2),(tol/2)]+integ[((a+b)/2),b,(tol/2)]]

Let's compare the answer with the built in NIntegrate command.

integ[0.05,1,0.005]

NIntegrate[f[x],{x,0.05,1}]

The following algorithm determines the list of points that describe where the  adaptive quadrature method evaluates the function.

integlist[a_,b_,tol_]:=
	If[N[Abs[S[a,b]-S[a,((a+b)/2)]-S[((a+b)/2),b]]<10 tol],
		{a,((a+b)/2),b},
		integlist[a,((a+b)/2),(tol/2)]⋃integlist[((a+b)/2),b,(tol/2)]]

ep=integlist[0.05,1,0.005]

Plot[f[x],{x,0.05,1},Epilog->{Red,Thickness[0.001],Table[Line[{{ep[[k]],-1},{ep[[k]],1}}],{k,1,Length[ep]}]}]