# Calculate area between two multivalued curves

I have to calculate the area between two curves which will give me the result of a particular quantity. However, both the curves are multivalued functions. Here is a data set showing the region where I have to calculate the area. The area to be calculated is the area between the red and the black curve in the range of x axis specified. However, I am unable to approximate a function for the curves and then to calculate the area.I tried to interpolate the two curves and then calculate the area but without any result. Help will be highly appreciated.

• Were is the data set????? – Mariusz Iwaniuk Jun 4 '15 at 10:17

This is a toy example that I hope will facilitate or motivate approach.

f[a_, x_] := a x^2/(1 + a x^2)
dat = Join[Table[{j, f[1, j]}, {j, 0, 6, 0.1}],
Table[{j, f[3, j]}, {j, 6, 0, -0.1}]];
{xs, ys} = Transpose[dat];
xf = ListInterpolation[xs, {0, 1}];
yf = ListInterpolation[ys, {0, 1}];
reg = Disk[{1, 0.4}, {1, 0.1}];
regp = Polygon[Table[{xf[j], yf[j]}, {j, 0, 1, 0.01}]];
int = RegionIntersection[reg, regp];
ri = RegionIntersection[DiscretizeRegion[reg],
DiscretizeRegion[regp]];
rp = RegionPlot[ri];
Show[ParametricPlot[{xf[t], yf[t]}, {t, 0, 1},
Epilog -> {Circle[{1, 0.4}, {1, 0.1}]}], rp, AspectRatio -> 1]
Area[ri] Summary:

• interpolate and parametrize your curves
• convert into regions
• region intersection
• determine area of intersection

Visualization to help further refinement, e.g. MaxCellMeasure etc

This is a pre-v10 way.

Let's start by proposing a set of functions:

fs = {Tanh[#] &, Tanh[# - 1] &, #/10 + 2/10 &, #/10 + 3/10 &};
Plot[Through[fs@x], {x, -5, 5}, Evaluated -> True] Now we generate a set of points in each curve to work with the interpolations.

ListPlot@(pts =Transpose[Table[Thread[{x, Through[fs@x]}], {x, -5, 5, .1}]])
fInts = Interpolation /@ pts Next we calculate the limits for the integration:

pt1 = GraphicsMeshFindIntersections[{Line @@ {pts[]}, Line @@ {pts[]}}]
pt2 = GraphicsMeshFindIntersections[{Line @@ {pts[]}, Line @@ {pts[]}}]
Plot[Through[fInts@x], {x, -5, 5},
Epilog -> {PointSize[Medium], Black, Point@pt1, Red, Point@pt2},
Evaluated -> True] And finally we perform the integration:

Plot[{Min[fInts[]@x, fInts[]@x],
Max[fInts[]@x, fInts[]@x]}, {x, pt1[[1, 1]], pt2[[1, 1]]},
Epilog -> {PointSize[Medium], Black, Point@pt1, Red, Point@pt2},
Evaluated -> True]
NIntegrate[
Min[fInts[]@x, fInts[]@x] -
Max[fInts[]@x, fInts[]@x], {x, pt1[[1, 1]], pt2[[1, 1]]}] (* 0.112747 *)


Compare with the exact value:

Integrate[
Boole[fs[]@x > fs[]@x &&
fs[]@x < fs[]@x] (Min[fs[]@x, fs[]@x] -
Max[fs[]@x, fs[]@x]), {x, -5, 5}] // N
(* 0.1  *)

• this is really cool...learned a lot...thanks +1 of course :) – ubpdqn Jun 4 '15 at 22:45
• ps I particular like the numerical integration of relevant interpolating functions using Min and Max – ubpdqn Jun 4 '15 at 22:52
• @ubpdqn Glad you liked it. Thanks! – Dr. belisarius Jun 4 '15 at 22:55