# Getting an Accurate Transformed Region (Part II)

I asked earlier about transforming a set of curves and getting an accurate plot when a curve goes to infinity:

Getting an Accurate Transformed Region

Here is an example where a transformed region should be the upper half plane, but instead Mathematica gives a strange result:

$$\cal R$$ = Region bounded by the circles $$x^2+ \left(y-\frac{1}{2}\right)^2=\frac{1}{4} \, \textit{ and } \, x^2+\left(y-\frac{1}{4}\right)^2=\frac{1}{16}$$

p[\[Alpha]_] := x^2 + (y - \[Alpha])^2 - \[Alpha]^2;
Q = (p[1/2] < 0) && (p[1/4] > 0);
\[ScriptCapitalR] = ImplicitRegion[Q, {x, y}];
a = Region[\[ScriptCapitalR], GridLines -> Automatic, Frame -> True];
aa = Region[RegionBoundary[\[ScriptCapitalR]],
BaseStyle -> RGBColor[.25, .25, .75]];
\[Tau] = Show[a, aa];


$$f(z) = \frac{1}{z},$$ and $$\cal E$$ is the transformed region $$\cal R$$ under the mapping $$f(z)$$.

f = Evaluate[{x/(x^2 + y^2), -(y/(x^2 + y^2))}] &;
\[ScriptCapitalE] = TransformedRegion[\[ScriptCapitalR], f];

b = Region[\[ScriptCapitalE], BaseStyle -> RGBColor[1, 0, 0, .7],
Frame -> True];
bb = Region[RegionBoundary[\[ScriptCapitalE]], BaseStyle -> RGBColor[.75, 0, 0],
FrameTicks -> {{None, Range[-4, 0]}, {Automatic, Automatic} }];
\[Upsilon] = Show[b, bb, PlotRange -> {{-3, 3}, {-3, 0}}, AspectRatio -> 1/2];


$$g(z) = \exp \pi z,$$ and $$\cal M$$ is the transformed region $$\cal E$$ under the mapping $$g(z)$$.

 g = Evaluate[{E^(\[Pi] x) Cos[\[Pi] y], E^(\[Pi] x) Sin[\[Pi] y]}] &;
\[ScriptCapitalM] = TransformedRegion[\[ScriptCapitalE], g];

c = Region[\[ScriptCapitalM], BaseStyle -> RGBColor[.75, .75, .75], Frame -> True];
cc = Region[RegionBoundary[\[ScriptCapitalM]],
BaseStyle -> RGBColor[.75, .1, .1],
FrameTicks -> {{None, Range[-4, 0]}, {Automatic, Automatic} }];
\[Phi] = Show[c, cc];


Plot $$\cal R$$, the region bounded by circles, $$\cal E$$, the image of $$\cal R$$ under the transformation $$f(z)=\frac{1}{z}$$, an infinite strip and $$\cal M$$, the image of $$\cal R$$ under the transformation $$g(f(z))=\exp \left( \pi / z \right)$$: should be the upper-half plane!

Here is Mathematica's rendition. Any ideas how to get a more accurate picture for $$\cal M$$?

 GraphicsRow[{\[Tau], \[Upsilon], \[Phi]}] Another related question: Why is there some of the light blue color missing at the bottom of region $$\cal R$$? Any way to improve this?

UPDATE

@Ulrich, thank you for the suggestions you made in the comment. Some questions:

I. As you've suggested, I've changed Region[] to RegionPlot[]. Now, the first figure is fully filled in, but the figure is incomplete where the circles are tangent. Not sure why.

 p[\[Alpha]_] := x^2 + (y - \[Alpha])^2 - \[Alpha]^2;
Q = (p[1/2] <=  0) && (p[1/4] >=  0);
\[ScriptCapitalR] = ImplicitRegion[Q, {x, y}];
a = RegionPlot[\[ScriptCapitalR],
PlotStyle -> RGBColor[.25, .75, .25, .5]];
aa = RegionPlot[RegionBoundary[\[ScriptCapitalR]],
BoundaryStyle -> Directive[Thickness[.01], RGBColor[0, .5, 0]]];
\[Tau] = Show[a, aa] II. I think that I understand why we need to use the syntax you suggest. We want to explictly define the functions in terms of two variables, rather than in terms of one input, a two-vector (a list of two elements)? Do we need to use Evaluate[]? I've used it because it appeared in one of the examples in the documentation, but is it necessary?

The function definition syntax works well on the first transformation:

 f = Function[{x, y}, Evaluate[{x/(x^2 + y^2), -(y/(x^2 + y^2))}]];
\[ScriptCapitalE] = TransformedRegion[\[ScriptCapitalR], f];

b = RegionPlot[\[ScriptCapitalE],
PlotStyle -> RGBColor[.85, .85, .85, .7]];
bb = RegionPlot[RegionBoundary[\[ScriptCapitalE]],
BoundaryStyle -> RGBColor[.5, .5, .5],
FrameTicks -> {{None, Range[-4, 0]}, {Automatic, Automatic} }];
\[Upsilon] =
Show[b, bb, PlotRange -> {{-3, 3}, {-3, 0}}, AspectRatio -> 1/2] Plotting the two figures together in a graphics row causes the "inner meshes" to be visible. Why is this?

 GraphicsRow[{\[Tau], \[Upsilon]}] These lines seem okay:

 g = Function[{x, y},
Evaluate[{E^(\[Pi] x) Cos[\[Pi] y], E^(\[Pi] x) Sin[\[Pi] y]}]];
\[ScriptCapitalM] = TransformedRegion[\[ScriptCapitalE], g];


Both of these lines cause errors:

 c = RegionPlot[\[ScriptCapitalM],
PlotStyle -> RGBColor[.15, .15, .85, .7]];

cc = RegionPlot[RegionBoundary[\[ScriptCapitalM]],
BoundaryStyle -> RGBColor[0, 0, .75],
FrameTicks -> {{None, Range[-4, 0]}, {Automatic, Automatic} }];


UPDATE #2 (In response to comments)

In Mathematica 11.2.0.0, this code:

 \[ScriptCapitalM] = TransformedRegion[\[ScriptCapitalE], g];

c = RegionPlot[\[ScriptCapitalM],
PlotStyle -> RGBColor[.15, .15, .85, .7]];
cc = RegionPlot[RegionBoundary[\[ScriptCapitalM]],
BoundaryStyle -> Directive[Thickness[.01], RGBColor[0, 0, .5]],
FrameTicks -> {{None, Range[-4, 0]}, {Automatic, Automatic} }];


runs, but produces a huge triangle in the lower half plane. This same code crashes in Mathematica 12.0.0.0.

The result is the same, with and without the use of Evaluate[].

In both versions of Mathematica (On Mac OS Version 10.14), the first transformation produces a strip, without that extra piece above it.

UPDATE #3

The method BoundaryMeshRegion[] works, but only if the region is first computed via TransformedRegion[].

 Needs@"NDSolveFEM";

Show[BoundaryMeshRegion@
ToBoundaryMesh[\[ScriptCapitalE],
MaxCellMeasure -> {"Length" -> 0.02}], Frame -> True,
PlotRange -> {{-3, 3}, {-3, 0}}, AspectRatio -> 1/2] • I tried the updated code. It runs in MMA v11.0.1. without error. Only Show[b,bb] shows two regions (see my answer) – Ulrich Neumann Aug 7 '19 at 7:18
• Definition f=.. without Evaluate  also works! – Ulrich Neumann Aug 7 '19 at 7:20
• Please see Update #2 included in the question. – mjw Aug 7 '19 at 16:48

Sometimes, I find it easier to work with the FEM meshing functions directly:

Needs@"NDSolveFEM";

BoundaryMeshRegion@
ToBoundaryMesh[\[ScriptCapitalR],
MaxCellMeasure -> {"Length" -> 0.02}] The second region is infinite....What to do? This? It's finite simply because ParametricPlot missed the singularity:

ff = Function[{x, y}, Evaluate[{x/(x^2 + y^2), -(y/(x^2 + y^2))}]];
Polygon[Transpose[ff @@ Transpose[Join[First@pts, Reverse@Last@pts]]]] (Compare with ParametricPlot[Evaluate@{ff @@ pp[1/4], ff @@ pp[1/2]}, {t, -Pi/2, 3 Pi/2}, PlotRange -> All, AspectRatio -> 1/4], using pp[a] below. The misrepresentation is due to numerics. Higher working precision is needed to avoid it, not to mention infinite sampling. What is really needed is a way to deal symbolically with the singularity in the transformation of the region.)

An elementary way to get the third region:

pp[a_] := {a Cos[t], a Sin[t] + a}

pts = Cases[
ParametricPlot[Evaluate@{pp[1/4], pp[1/2]}, {t, -Pi/2, 3 Pi/2}],
Line[p_] :> p, Infinity];
lens = Length /@ pts;

gg = Function[{x, y}, {E^(\[Pi] x) Cos[\[Pi] y], E^(\[Pi] x) Sin[\[Pi] y]}];

bmesh = ToBoundaryMesh[
"Coordinates" -> Transpose[gg @@ Transpose[Join @@ pts]],
"BoundaryElements" -> {
LineElement[Partition[Range@lens[], 2, 1, 1]],
LineElement[Partition[lens[] + Range@lens[], 2, 1, 1]]},
"RegionHoles" -> {gg[0., 1./8]}
];

BoundaryMeshRegion@bmesh • Thank you for your answer. This looks like a nice way of rendering regions, but the regions first must be computed and I think computing the regions is where the issue is. Please see Update #3 included in the question. – mjw Aug 7 '19 at 16:49
• What are the points pts defined to be? Thank you – mjw Aug 8 '19 at 12:56
• It's there: pts = Cases[ ParametricPlot[Evaluate@{pp[1/4], pp[1/2]}, {t, -Pi/2, 3 Pi/2}], Line[p_] :> p, Infinity]; but maybe Table just as easy... – Michael E2 Aug 8 '19 at 13:01
• Okay, missed it. Was looking at it on a phone earlier. I'll look again more carefully. I am sure there is a lot to learn from your answer. Just a quick comment: I am sure you already know this, but the "blob" figure is a product of Mathematica's inability to handle this calculation. The "correct region" for this transformation is the upper-half plane. It probably is that since Mathematica already mishandled the previous transformation, there is no way it can do the right thing here. – mjw Aug 8 '19 at 15:35
• @mjw No problem. Originally I wasn't going to say anything about the second region/first transformation because it's unsatisfactory. And then the explanation started to grow...but the code is with the 3rd region. – Michael E2 Aug 8 '19 at 15:44

First change Region to RegionPlot (6x). Second change the function definitions f&g

f = Function[{x, y}, Evaluate[{x/(x^2 + y^2), -(y/(x^2 + y^2))}]];
g = Function[{x, y},Evaluate[{E^(\[Pi] x) Cos[\[Pi] y], E^(\[Pi] x) Sin[\[Pi] y]}]];

\[Tau] = Show[a, aa]
[![enter image description here]]

\[Upsilon] =Show[b, bb, PlotRange -> {{-3, 3}, {-3, 0}}, AspectRatio -> 1/2] \[Phi] = Show[c, cc] The main problem for the several difficulties seem to be the singular point x=0,y=0 which causes problems in the transformation \[ScriptCapitalR]->\[ScriptCapitalE] ( Mathematica v11.0.1. )

Assuming the exact \[ScriptCapitalE] to be

\[ScriptCapitalE] = ImplicitRegion[-2 <= y <= -1, {x, y}];


the third transformation evaluates to

g = Function[{x, y}, {E^(\[Pi] x) Cos[\[Pi] y],
E^(\[Pi] x) Sin[\[Pi] y]}];
\[ScriptCapitalM] = TransformedRegion[\[ScriptCapitalE], g ];
c=RegionPlot[\[ScriptCapitalM], MaxRecursion -> 4] which is obviously wrong (?TransformateRegion?) because c must be infinite!

• Thank you very much for your help! I've tried your suggestions, which led to further questions (included as an update to the original question). Also, looks like there is some extra piece above the infinite strip in your first figure. You've got the region between to the two circles nicely plotted. My plot (using RegionPlot[]) now does not have the figure connected at the bottom. – mjw Aug 6 '19 at 16:25