7

The area of ImplicitRegion gives two very different answers when I introduce a small amount of error.

poly[x_, y_] = 4.3 x + 2.1 y;
triangle = Triangle[{{-1., 0.}, {0., 1.}, {1., 0.}}];
Show[Graphics[{Transparent, EdgeForm[{Thick, Black}], triangle}],
 ContourPlot[poly[x, y], {x, y} \[Element] triangle, Contours -> {0}]]

reg = ImplicitRegion[
   poly[x, y] < 0 && {x, y} \[Element] triangle, {x, y}];
area = RegionMeasure[reg]
Show[Graphics[{Transparent, EdgeForm[{Thick, Black}], triangle}],
 RegionPlot[reg]]

In the case above the area is about 0.335937. When I introduce a small amount of error into the polynomial poly[x_, y_] = x (4.3 + 4.440892098500626*^-16 y) + 2.1 y, RegionMeasure returns an area of 0.5, which is clearly wrong because the area of triangle is equal to 1 and from the plots you can see that the shaded region is less than half of the triangle. How can I get Mathematica to give me the correct area in the second case?

jerjorg
  • 453
  • 2
  • 5

2 Answers2

8

I think RegionMeasure factorizes through Region which is meant only as preview and is also very buggy. RegionMeasure@BoundaryDiscretizeRegion@reg seems to return a more plausible result.

So this rule of thumb: Do not rely on Region; always discretize.

Henrik Schumacher
  • 106,770
  • 7
  • 179
  • 309
7

Using Rationalize and arbitrary-precision produces consistent results

poly[x_, y_] = 4.3 x + 2.1 y // Rationalize // Simplify;

triangle = Triangle[{{-1., 0.}, {0., 1.}, {1., 0.}} // Rationalize];

reg = ImplicitRegion[poly[x, y] < 0 && {x, y} ∈ triangle, {x, y}];

area = RegionMeasure[reg]

(* 43/128 *)

area // N // InputForm

(* 0.3359375 *)

poly2[x_, y_] = 
  x (4.3 + 4.440892098500626*^-16 y) + 2.1 y // Rationalize[#, 0] &;

reg2 = ImplicitRegion[poly2[x, y] < 0 && {x, y} ∈ triangle, {x, y}];

area2 = RegionMeasure[reg2]

(* 1/100 (-1784852045121347717883298492448743 + 
   24769797950537733 Sqrt[5192296858534827876228475834597401] + 
   4578753968024364598206091977818112 Log[23643898043695104] - 
   4578753968024364598206091977818112 Log[
     1/2 (-24769797950537733 + Sqrt[5192296858534827876228475834597401])]) *)

Evaluating this requires arbitrary-precision rather than machine precision.

N[area2, #] & /@ {MachinePrecision, 10, 15, 20}

(* {-2.8823*10^15, 0.3359375000, 0.335937500000000, 0.33593750000000000510} *)

area/area2 // N[#, 20] &

(* 0.99999999999999998482 *)
Bob Hanlon
  • 157,611
  • 7
  • 77
  • 198