2
$\begingroup$

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]}]

enter image description here

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]

enter image description here

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]

enter image description here

Plotting the two figures together in a graphics row causes the "inner meshes" to be visible. Why is this?

 GraphicsRow[{\[Tau], \[Upsilon]}]

enter image description here

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.

enter image description here

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@"NDSolve`FEM`";

 Show[BoundaryMeshRegion@
   ToBoundaryMesh[\[ScriptCapitalE], 
    MaxCellMeasure -> {"Length" -> 0.02}], Frame -> True, 
         PlotRange -> {{-3, 3}, {-3, 0}}, AspectRatio -> 1/2]

enter image description here

$\endgroup$
  • $\begingroup$ I tried the updated code. It runs in MMA v11.0.1. without error. Only Show[b,bb] shows two regions (see my answer) $\endgroup$ – Ulrich Neumann Aug 7 at 7:18
  • $\begingroup$ Definition f=.. without Evaluate also works! $\endgroup$ – Ulrich Neumann Aug 7 at 7:20
  • $\begingroup$ Please see Update #2 included in the question. $\endgroup$ – mjw Aug 7 at 16:48
1
$\begingroup$

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

Needs@"NDSolve`FEM`";

BoundaryMeshRegion@
 ToBoundaryMesh[\[ScriptCapitalR], 
  MaxCellMeasure -> {"Length" -> 0.02}]

enter image description here

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]]]]

enter image description here

(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[[1]], 2, 1, 1]],
     LineElement[Partition[lens[[1]] + Range@lens[[2]], 2, 1, 1]]},
   "RegionHoles" -> {gg[0., 1./8]}
   ];

BoundaryMeshRegion@bmesh

enter image description here

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – mjw Aug 7 at 16:49
  • $\begingroup$ What are the points pts defined to be? Thank you $\endgroup$ – mjw Aug 8 at 12:56
  • $\begingroup$ 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... $\endgroup$ – Michael E2 Aug 8 at 13:01
  • $\begingroup$ 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. $\endgroup$ – mjw Aug 8 at 15:35
  • $\begingroup$ @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. $\endgroup$ – Michael E2 Aug 8 at 15:44
0
$\begingroup$

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][1]][1]

\[Upsilon] =Show[b, bb, PlotRange -> {{-3, 3}, {-3, 0}}, AspectRatio -> 1/2]

enter image description here

\[Phi] = Show[c, cc]

enter image description here

addenum

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]     

enter image description here

which is obviously wrong (?TransformateRegion?) because c must be infinite!

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – mjw Aug 6 at 16:25

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.