2
$\begingroup$

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. Data set between whom the area is to be calculated

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.

$\endgroup$
  • $\begingroup$ Were is the data set????? $\endgroup$ – Mariusz Iwaniuk Jun 4 '15 at 10:17
5
$\begingroup$

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]

enter image description here

Summary:

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

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

| improve this answer | |
$\endgroup$
3
$\begingroup$

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]

Mathematica graphics

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

Mathematica graphics

Next we calculate the limits for the integration:

pt1 = Graphics`Mesh`FindIntersections[{Line @@ {pts[[1]]}, Line @@ {pts[[3]]}}]
pt2 = Graphics`Mesh`FindIntersections[{Line @@ {pts[[2]]}, Line @@ {pts[[4]]}}]
Plot[Through[fInts@x], {x, -5, 5}, 
     Epilog -> {PointSize[Medium], Black, Point@pt1, Red, Point@pt2}, 
     Evaluated -> True]

Mathematica graphics

And finally we perform the integration:

Plot[{Min[fInts[[1]]@x, fInts[[4]]@x], 
      Max[fInts[[2]]@x, fInts[[3]]@x]}, {x, pt1[[1, 1]], pt2[[1, 1]]}, 
      Epilog -> {PointSize[Medium], Black, Point@pt1, Red, Point@pt2}, 
      Evaluated -> True]
NIntegrate[
      Min[fInts[[1]]@x, fInts[[4]]@x] - 
      Max[fInts[[2]]@x, fInts[[3]]@x], {x, pt1[[1, 1]], pt2[[1, 1]]}]

Mathematica graphics

(* 0.112747 *)

Compare with the exact value:

Integrate[
  Boole[fs[[1]]@x > fs[[4]]@x && 
        fs[[2]]@x < fs[[3]]@x] (Min[fs[[1]]@x, fs[[4]]@x] - 
                                Max[fs[[2]]@x, fs[[3]]@x]), {x, -5, 5}] // N 
(* 0.1  *)
| improve this answer | |
$\endgroup$
  • $\begingroup$ this is really cool...learned a lot...thanks +1 of course :) $\endgroup$ – ubpdqn Jun 4 '15 at 22:45
  • $\begingroup$ ps I particular like the numerical integration of relevant interpolating functions using Min and Max $\endgroup$ – ubpdqn Jun 4 '15 at 22:52
  • $\begingroup$ @ubpdqn Glad you liked it. Thanks! $\endgroup$ – Dr. belisarius Jun 4 '15 at 22:55

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.