# Calculating area for a weird shaped numerical curve

I have a numerical data by this code

data=Uncompress[FromCharacterCode@
Flatten[ImageData[Import["https://i.stack.imgur.com/OiZrp.png"],"Byte"]]]


And I want to find the area of that shape as shown in the figure. How do I approach this problem in Mathematica? The issue is that length at say 50 and 50.5 can be very different.

What I tried to do was to negate the y values and align the horizontal as zero, so that Interpolation would do the job. Any clever ideas?

• Is this question about software Mathematica or about signal processing? In its current form this question may be more appropriate for dsp.stackexchange.com. Apr 2 '17 at 10:06
• Yes Alexey , How to do this in mathematica
– TM90
Apr 2 '17 at 10:20
• I have mentioned that
– TM90
Apr 2 '17 at 10:21
• How to you exactly define "the area here"? Apr 2 '17 at 12:50

There are many anwsers already, but i want to point out a (in my opinion) simpler approach. Just use Mathematicas Area build-in.

(Your data is in data)

lineHeight = 0.55;
sData = {{data[[-1, 1]], lineHeight}, {data[[1, 1]], lineHeight}}~ Join~data;
(*append data with edgepoints*)
sData[[All, 2]] = Min[lineHeight, #] & /@ sData[[All, 2]];
(*comment this line if you wan to have no clipping*)
poly = Polygon[sData]; (*make the polygon*)
ListLinePlot[data, PlotRange -> All, Epilog -> {Gray, poly}, ImageSize -> Large]
(*plot it*)
Area@poly (*calc the area*)


With clipping:

0.00392424

Without clipping:

0.00626118

BTW: an interpolation can add more unwanted area because it smoothes between the points. Its on your behalf to decide if you want that.

• Thank you very much, Julien Kluge , This is exactly what I want
– TM90
Apr 2 '17 at 22:56
• @ Julien, When use Needs["polytopes"]. It loads successfully but Area function is in red color? and whenever I compute this, the system crashes
– TM90
Apr 3 '17 at 1:41
• What version are you using, @TM90? Area[] has been built-in since version 10. What are you using the Polytopes package for? Apr 3 '17 at 2:55
• @ J.M 11.0 version. When I tried to do this even without polytopes, it had been crashing
– TM90
Apr 3 '17 at 5:09
• What is polytopes for? The code should work out of the box. Apr 3 '17 at 17:06

The line on your plot looks like

line[x_] = InterpolatingPolynomial[{{50, 0.56}, {50.5, 0.55}}, x];
SetAttributes[line, Listable]


And the data curve is

interpolant[x_] = Interpolation[data, x, InterpolationOrder -> 1];


Plot[{line[x], interpolant[x]},
{x, Sequence @@ MinMax[data[[All, 1]]]}, PlotRange -> All]


First find which data points are near the roots between the difference of the curves. I take the longest sequence without sign changes and include the first occurrence of different sign in both ends, because the roots are between different signs:

roots = With[{Q = Length /@ SplitBy[line[data[[All, 1]]] - data[[All, 2]], Sign]},
Accumulate[Q][[Join[# - 1, #]]] &[Ordering[Q, -1]] + {{0, 1}, {0, 1}}]


Then the integration limits:

lims = x /. FindRoot[line[x] - interpolant[x], {x, data[[#, 1]], data[[#2, 1]]}] & @@@ roots


Result:

Integrate[line[x], {x, Sequence @@ lims}] -
Integrate[interpolant[x], {x, Sequence @@ lims}]


0.0042779763

• down vote? Would you please tell why.. Apr 2 '17 at 11:22
• Maybe the DV is because you don't use Tai's Method :) But seriously, yours is a reasonable approach to a reasonable interpretation of the question. (What might deserve a DV is the question, which is not clear: It's impossible to tell which of the approaches posted give a correct answer.) -- BTW, you can get an antiderivative of a non-spline InterpolatingFunction more quickly than integrating it. Use Integrate[interpolant[x], x] or Evaluate@Integrate[interpolant[#], #] &. (Speed is not really important here, though.) Apr 2 '17 at 13:50
• Okay, I upvoted, in part to offset the down vote. I have to say, the link from @MichaelE2 cracked me up. And I agree, the approach in this response seems fine. Apr 2 '17 at 15:24
• @Coolwater, Thank you very much for your reply.This is more or less that I want.
– TM90
Apr 2 '17 at 22:57

Writing:

data = {{50., 0.55403}, ..., {50.5, 0.553796}};
bar = 0.56;

ListLinePlot[{data, {{First[data][[1]], bar}, {Last[data][[1]], bar}}},
PlotRange -> All,
Filling -> {1 -> {2}},
AxesLabel -> {x, y}
]

Integrate[1,
{x, First[data][[1]], Last[data][[1]]},
{y, Min[Interpolation[data][x], bar], Max[Interpolation[data][x], bar]}
] // N
`

I get:

0.00677696008549726

which are the graph and the desired area.

• @ Manu This is not what I want, The thing you showed is just area under the curve. what I need is the area I mentioned between the curve and the straight line.
– TM90
Apr 2 '17 at 10:50
• ,Thank you very much and I agree
– TM90
Apr 2 '17 at 22:54