# Finding the area enclosed by two curves

I am trying to find the area enclosed between two curves (i.e., two datasets).

The challenge is to estimate the cross-sectional area. as indicated in blue.

The first dataset represents the bathymetry of the water channel.

The other dataset represents the water surface level.

I followed the example in this post: Measuring the area between two curves but I obtained negative result (-8.48313). I realized that I receive negative area in the case of low water level.

bathy={{-2.8, 2.611}, {-0.18, 0.991}, {0., 0.665}, {5.35, 0.},{12.08, 0.482}, {21.51, 0.78}, {30.92, 0.807}, {40.44, 0.692},{49.47,0.592}};

lev={{-2.8, 0.5}, {-0.18, 0.5}, {0., 0.5}, {5.35, 0.5}, {12.08,0.5}, {21.51, 0.5}, {30.92, 0.5}, {40.44, 0.5}, {49.47, 0.5}}


Any suggestions?

• We filling the bathy to Top and filling the lev to Bottom to get two regions and calculate the Area of their RegionIntersection.
reg1 = ListPlot[bathy, Filling -> Top, Joined -> True,
MeshShading -> {Red, Blue}, PlotRange -> All, PlotStyle -> Green];
reg2 = ListPlot[lev, Filling -> Bottom, Joined -> True,
MeshShading -> {Red, Blue}, PlotRange -> All, PlotStyle -> Yellow];
reg12 = RegionIntersection[DiscretizeGraphics@reg1,
DiscretizeGraphics@reg2];
Area[reg12]
Show[reg1, reg2, Graphics[{Blue, reg12}]]


2.75384

• Here we test another data. We try to calculate the area of two curves crossing each other,but the code need to be updated.
Clear["Global*"];
bathy = Table[{x, Sin[π*x]^2 E^-x}, {x, 0, 5, .1}];
lev = Table[{x, Cos[π*x]^2 E^-x}, {x, -1, 3, .1}];
plot = ListPlot[{bathy, lev}, Joined -> True, PlotRange -> All];
intersection =
SortBy[RegionIntersection[Line[bathy], Line[lev]][[1]], First];
regs = Table[
Polygon@Join[{intersection[[i]]},
Select[bathy,
intersection[[i, 1]] <= First@# <=
intersection[[i + 1, 1]] &], {intersection[[i + 1]]},
Reverse@Select[lev,
intersection[[i, 1]] <= First@# <=
intersection[[i + 1, 1]] &]], {i, 1,
Length@intersection - 1}];
Area[regs] // Total
Graphics[{Cyan, regs, plot[[1]]}, Method -> {"AxesInFront" -> False},
ImageSize -> Large, Axes -> True]


0.43827

Using the method from the question linked in the post:

bathy = {{-2.8, 2.611}, {-0.18, 0.991}, {0., 0.665}, {5.35, 0.}, {12.08, 0.482}, {21.51, 0.78}, {30.92, 0.807}, {40.44, 0.692}, {49.47, 0.592}};
lev = {{-2.8, 0.5}, {-0.18, 0.5}, {0., 0.5}, {5.35, 0.5}, {12.08, 0.5}, {21.51, 0.5}, {30.92, 0.5}, {40.44, 0.5}, {49.47, 0.5}};

ip1 = Interpolation[bathy, InterpolationOrder -> 1];
ip2 = Interpolation[lev, InterpolationOrder -> 1];

NIntegrate[
Max[(ip2[x] - ip1[x]), 0], {x, Min[lev[[All, 1]]], Max[lev[[All, 1]]]}]


2.75383

Visualizing what is being integrated:

Plot[Max[(ip2[x] - ip1[x]), 0], {x, Min[lev[[All, 1]]], Max[lev[[All, 1]]]}, PlotRange -> All]


The question is unclear! Are you looking for the signed or unsigned area?

poly = Polygon[Join[ bathy , Reverse[lev] ]]
Area[poly]   (*unsigned area 13.9908 *)
Show[{ListPlot[{bathy, lev}, PlotRange -> All],Graphics[{ FaceForm[Lighter[Gray]], poly }]}]


Check result

ip1 = Interpolation[bathy, InterpolationOrder -> 1]
ip2 = Interpolation[lev, InterpolationOrder -> 1]
NIntegrate[RealAbs[ip1[x] - ip2[x]], {x, Min[bathy[[All, 1]]],Max[bathy[[All, 1]]]}]
(* unsigned area 13.9908*)

NIntegrate[ ip1[x] - ip2[x] , {x, Min[bathy[[All, 1]]],Max[bathy[[All, 1]]]}]
(* signed area 8.48313 *)

• I want to obtain the area shsaded in blue. I think -8.48313 is incorrect in my case. Commented Oct 18, 2023 at 21:04
• @Mehmet Thanks for the edit of your question. Now it's much clearer. The area you are looking for ist NIntegrate[ (ip2[x] - ip1[x]) Boole[ip2[x] >= ip1[x]] , {x, Min[bathy[[All, 1]]], Max[bathy[[All, 1]]]}] (*2.75383*)` Commented Oct 19, 2023 at 7:00