# Plotting RegionIntersection

A new feature added in Mathematica 11.2 gives the ability to easily plot region intersection (see this post, scroll down to 3D Computational Geometry). However, I can't seem to understand how to find the intersection of following objects:

contourRegionPlot3D[region_, {x_, x0_, x1_}, {y_, y0_, y1_}, {z_, z0_, z1_},
opts : OptionsPattern[]] := Module[{reg, preds},
reg = LogicalExpand[region && x0 <= x <= x1 && y0 <= y <= y1 && z0 <= z <= z1];
preds = Union@Cases[reg, _Greater | _GreaterEqual | _Less | _LessEqual, -1];
Show @ Table[ContourPlot3D[
Evaluate[Equal @@ p], {x, x0, x1}, {y, y0, y1}, {z, z0, z1},
RegionFunction -> Function @@ {{x, y, z}, Refine[reg, p] && Refine[! reg, ! p]},
opts], {p, preds}]]

shift = {1.2, 1, 1};
heart = ImplicitRegion[((y - shift[])^2 + (9 (x - shift[])^2)/ 4 + (z -
shift[])^2 - 1)^3 - (y - shift[])^2 (z - shift[])^3 - (9 (x -
shift[])^2 (z - shift[])^3)/80 < 0, {x, y, z}];
heartPlot = RegionPlot3D[
heart,
PlotRange -> {{-0.5, 2.5}, {-2.5, 2.5}, {-0.5, 2.5}},
PlotPoints -> 30,
PlotStyle -> Directive[lightBlue, Opacity[0.4]]
];
arcRegion = 1.4 < x^2 + y^2 < 1.6 && 1.4 < z < 1.6 && 1 \[Pi]/64 < ArcTan[x, y] < 27 \[Pi]/64;
arcRegionPlot =  contourRegionPlot3D[arcRegion, {x, 0.1, 2}, {y, 0.1, 2}, {z, 1.2, 1.8}];

RegionIntersection[
heartPlot // DiscretizeGraphics,
arcRegionPlot // DiscretizeGraphics
]


And here's what I get as an output: What am I doing wrong here? I know that those 2 regions for sure intersect: • Without going into details, I suspect problems with the dimensionality of regions (surface vs. volume). Do you want to treat them as volumes? Oct 16, 2017 at 12:46
• @Szabolcs, Frankly, I'm not sure. What I want is to have a nice annular tunnel cut through the heart. Oct 16, 2017 at 12:48
• I wouldn't expect much consistency in dimensionality from DiscretizeGraphics. Graphics are just for looks. When you do an intersection then a surface and a volume are very different. I would try RegionIntersection or RegionDifference on the ImplicitRegion objects, then use BoundaryDiscretizeRegion with explicit bounds on the result. Oct 16, 2017 at 12:55
• @Szabolcs, I've updated my question according to your suggestion. It works but produces some unwanted visual artifacts. Any ideas how to get rid of them? Oct 16, 2017 at 13:41
• Decrease MaxCellMeasure? Try different Method values? Oct 16, 2017 at 13:45

Following @Szabolcs's advice, here's what I could accomplish:

lightBlue = RGBColor[0.593454, 0.888609, 0.918547];
shift = {1.2, 1, 1};
heart = ImplicitRegion[((y - shift[])^2 + (9 (x - shift[])^2)/ 4 + (z -
shift[])^2 - 1)^3 - (y - shift[])^2 (z - shift[])^3 - (9 (x -
shift[])^2 (z - shift[])^3)/80 < 0, {x, y, z}];
heartPlot = RegionPlot3D[
heart,
PlotRange -> {{-0.5, 2.5}, {-2.5, 2.5}, {-0.5, 2.5}},
PlotPoints -> 100,
PlotStyle -> Directive[lightBlue, Opacity[0.4]]
];
arcRegionImplicit = ImplicitRegion[1.4^2 < x^2 + y^2 < 1.6^2 && 1.4 < z < 1.6 && 0 < ArcTan[x, y] < \[Pi]/2, {x, y, z}];

Show[
heartPlot,
RegionPlot3D[BoundaryDiscretizeRegion[RegionIntersection[heart, arcRegionImplicit], MaxCellMeasure -> 0.001]]
]