Skip to main content

code review - Numerical Integration Via Adaptive Simpson's Method


I have written a code that uses the Adaptive Simpson's method to approximate integration. For those who are unaware of this Adaptive Simpson's method; Adaptive Simpson's method


In my code, I count the number of function evaluations are needed. I am wondering if there is a way to reduce the number of function evaluations needed but still retaining the same outputs and error. Here is my code:


Simpson[f_, a_, b_, er_] := Module[{s1, s2, h2, h = (b - a)/2},

s1 = h (f[a] + 4 f[a + h] + f[b])/3;
h2 = h/2;
s2 = h2 (f[a] + 4 f[a + h2] + 2 f[a + h] + 4 f[b - h2] + f[b])/3;


If[Abs[s1 - s2]/15 < er, s2 + (s2 - s1)/15,
Simpson[f, a, a + h, er/2] + Simpson[f, a + h, b, er/2]]];
count = 0;
h[x_] := Module[{}, count++; 3 Sqrt[x]];
N[Simpson[h, 0, 1, 10.^-5] - 2]
count

For example, when approximating the integral of $3*sqrt(x)$ from 0 to 1, my algorithm makes 312 function calls of the function h, but I suspect some of these evaluations are repeated.



Answer




With a simple modification to your code


Simpson[f_, a_, b_, er_] := 
Module[{s1, s2, h2, h = (b - a)/2},
s1 = h (f[a] + 4 f[a + h] + f[b])/3;
h2 = h/2;
s2 = h2 (f[a] + 4 f[a + h2] + 2 f[a + h] + 4 f[b - h2] + f[b])/3;
If[Abs[s1 - s2]/15 < er, s2 + (s2 - s1)/15,
Simpson[f, a, a + h, er/2] + Simpson[f, a + h, b, er/2]]];
count = 0;
h[x_] := Module[{}, Sow[x]; count++; 3 Sqrt[x]];

{result, xvalues} = Reap[N[Simpson[h, 0, 1, 10.^-5] - 2]];
{Length[Union[Flatten[xvalues]]], count}
(* {81, 312} *)

we can see that indeed your code evaluates h 312 times but at only 81 distinct values.


If the execution time of the integration is dominated by evaluating h this is clearly undesirable. A simple fix is to use "memoisation". This avoids re-evaluating h for values of x where it has already been computed. This can easily be done by using a definition for h such as


h[x_]:=h[x]= 3 Sqrt[x]

There is a very clear discussion of this in the Mathematica documentation https://reference.wolfram.com/language/tutorial/FunctionsThatRememberValuesTheyHaveFound.html


Comments

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...

list manipulation - Selecting multiple columns from a matrix?

Sample data: data = { {{2013, 1, 1}, 24.13, 167.67, 231.82}, {{2013, 1, 2}, 32.15, 170.92, 225.99}, {{2013, 1, 3}, 35.43, 172.68, 221.67}, {{2013, 1, 4}, 36.73, 173.05, 218.32}, {{2013, 1, 5}, 58.19, 165.96, 197.05}, {{2013, 1, 6}, 69.99, 163.50, 187.52}, {{2013, 1, 7}, 71.37, 154.21, 175.58}, {{2013, 1, 8}, 72.51, 149.66, 163.25}}; I want a DateListPlot with three graphs, so for a matrix formed by columns 1 and 2, one for columns 1 and 3, and 1 for columns 1 and 4. At the moment I'm using this code: data2 = Transpose[{data[[All, 1]], data[[All, 2]]}]; data3 = Transpose[{data[[All, 1]], data[[All, 3]]}]; data4 = Transpose[{data[[All, 1]], data[[All, 4]]}]; DateListPlot[{data2, data3, data4}, Joined -> True, Filling -> {3 -> {1}}] but I have a hunch that this can be done more efficiently. I don't like the Transpose s in particular. Any ideas? edit (for extra credit) What if I need to multiply the second column by 2, which in my solution is simp...

equation solving - Invert and fit implicitly defined curve

I need to fit an implicitly defined curve. I thought I could get some data out of Solve , and then using FindFit . Therefore, I would like to find the relation the parametric curve defined by $F(x,y)=0$: Solve[-(1/2) + 1/2 (0.41202 BesselK[0, 0.1 Sqrt[x^2 + y^2]] + (0.101483 x BesselK[1, 0.1 Sqrt[x^2 + y^2]])/Sqrt[x^2 + y^2]) == 0, y] But I can't get an output: Solve was unable to solve the system with inexact coefficients or the system obtained by direct rationalization of inexact numbers present in the system. Since many of the methods used by Solve require exact input, providing Solve with an exact version of the system may help. >> Edit: In particular, I would like to fit the data coming from the curve with the expression of another curve, and not with a function $f(x)$. In particular, since this clearly looks like a cardioid , I would like it to fit to something like it. What other strategies could I try?