2
$\begingroup$

This is related to a previous question but now I would like to apply a geometric transformation to the region function first. (I am trying to paint a spot on a cylinder, where the spot is the region that intersects a transformed hyperboloid):

r = 5; l = 10;
tube = Show[{With[{a = 0.5, b = 0.5, c = 50},
 ParametricPlot3D[
  RotationTransform[{{0, 0, 1}, {0, 1, 1}}][{a (1 + u^2)^0.5 Cos[
      v], b (1 + u^2)^0.5 Sin[v], c u}], {v, 0, 2 Pi}, {u, 0, 
   1.0}, Mesh -> None, PlotRange -> {{-r, r}, {-r, r}, {0, l}}, 
  RegionFunction -> Function[{x, y, z}, (x^2 + y^2) < r^2]
  , PerformanceGoal -> "Quality", MaxRecursion -> 5]]
}];
Show[Graphics3D[ParametricPlot3D[{r Cos[\[Theta]], r Sin[\[Theta]], z }, {\[Theta], 0, 
 2 \[Pi]}, {z, 0, l},
 PlotStyle -> Opacity[0.2], Mesh -> None][[1]],Boxed -> False], tube, Axes -> True]

Gives the cylinder and hyperboloid expected, showing the intersection surface I want to draw:

enter image description here

But this:

With[{r = 5, l = 10, a = 0.5, b = 0.5, c = 50}, 
ContourPlot3D[x^2 + y^2 == r^2, {x, -r, r}, {y, -r, r}, {z, 0, l}, 
RegionFunction -> 
RotationTransform[{{0, 0, 1}, {0, 1, 1}}] Function[{x, y, 
  z}, (x/a)^2 + (y/b)^2 - (z/c)^2 == 1], Mesh -> None,
PlotRange -> {{-r, r}, {-r, r}, {0, l}}, BoundaryStyle -> None,
Boxed -> False, Mesh -> None, Axes -> True, ContourStyle -> Opacity[0.2]]]

Gives the complete cylinder, not the transformed region I tried to define:

enter image description here

I was hoping to get something more like this, i.e. the part of the cylinder bounded by the intersection with the tilted hyperboloid:

enter image description here

That used a similar syntax but without the GeometricTransformation:

With[{a = 0.5, b = 0.5, r = 5, l = 5}, 
ContourPlot3D[x^2/r^2 + y^2/r^2 == 1,
{x, -r, r}, {y, -r, r}, {z, -l/2, l/2}, 
RegionFunction ->
Function[{x, y, z}, (x/a)^2 + (z/b)^2 < r^2 && y > 0], Mesh -> None,
PerformanceGoal -> "Quality", 
PlotRange -> {{-r, r}, {-r, r}, {-l, l}}, PlotPoints -> 10]]

How do I apply the geometric transformation to the region function? Or should I be doing it some other way?

$\endgroup$
  • $\begingroup$ Have you tried RegionIntersection? $\endgroup$ – aardvark2012 Aug 18 '17 at 7:43
  • $\begingroup$ Ah, that looks like a new function to me since i looked last, maybe just what I need! Will have a go with that. Thanks $\endgroup$ – DrBubbles Aug 18 '17 at 7:50
  • $\begingroup$ RegionIntersection appears to need correctly specified regions, while my cylinder and hyperboloid don't appear to be regions, rather they are Graphics3D. I expect there's a solution using MeshRegion as @"Michael E2" used in the previous question (linked at the top) but I can't get my head around it. $\endgroup$ – DrBubbles Aug 18 '17 at 16:05
3
$\begingroup$

I think the function you're looking for is TransformedRegion. (And a dash of code voodoo -- it seems like there are a hundred ways in which this could be done, but this is the only one I found that actually worked.) In your case, it works like

treg = TransformedRegion[
 ImplicitRegion[(x/a)^2 + (y/b)^2 <= 1 + (z/c)^2, {{x, -r - 1, r + 1}, 
  {y, -r - 1, r + 1}, {z, 0, l}}], 
 RotationTransform[{{0, 0, 1}, {0, 1, 1}}]
]

This gives you a valid region, which (unfortunately) you can't use directly in RegionFunction because RegionFunction needs to return True or False for any given arguments. So to use this region for plotting (in RegionFunction or in RegionPlot3D) you need to use

Evaluate@RegionMember[treg]

Plotting the two regions of interest:

With[{a = 0.5, b = 0.5, r = 5, l = 10, c = 50},
 Show[
  ContourPlot3D[
   x^2/r^2 + y^2/r^2 == 1, {x, -r, r}, {y, -r, r}, {z, 0, l},
   Mesh -> None, PerformanceGoal -> "Quality", 
   PlotRange -> {{-r - 1, r + 1}, {-r - 1, r + 1}, {0, l}}, 
   PlotPoints -> 10, ContourStyle -> Opacity[0.5]],
  RegionPlot3D[
   Evaluate@
    RegionMember[
     TransformedRegion[
      ImplicitRegion[(x/a)^2 + (y/b)^2 <= 
        1 + (z/c)^2, {{x, -r - 1, r + 1}, {y, -r - 1, r + 1}, {z, 0, l}}], 
         RotationTransform[{{0, 0, 1}, {0, 1, 1}}]], {x, y, z}], 
      {x, -r - 1, r + 1}, {y, -r - 1, r + 1}, {z, 0, l}, 
   PlotPoints -> 20],
  ViewPoint -> {Pi, Pi/2, 2}
  ]
 ]

enter image description here

And to paint the spot on the cylinder:

With[{a = 0.5, b = 0.5, r = 5, l = 10, c = 50},
 Show[
  ContourPlot3D[
   x^2/r^2 + y^2/r^2 == 1, {x, -r, r}, {y, -r, r}, {z, 0, l},
   Mesh -> None, PerformanceGoal -> "Quality", 
   PlotRange -> {{-r - 1, r + 1}, {-r - 1, r + 1}, {0, l}}, 
   PlotPoints -> 10, ContourStyle -> Opacity[0.5]],
  ContourPlot3D[
   x^2/r^2 + y^2/r^2 == 1, {x, -r, r}, {y, -r, r}, {z, 0, l},
   RegionFunction -> 
    Function[{x, y, z}, 
     Evaluate@
      RegionMember[
       TransformedRegion[
        ImplicitRegion[(x/a)^2 + (y/b)^2 <= 
          1 + (z/c)^2, {{x, -r, r}, {y, -r, r}, {z, 0, l}}], 
        RotationTransform[{{0, 0, 1}, {0, 1, 1}}]], {x, y, z}]],
   Mesh -> None, PerformanceGoal -> "Quality", 
   PlotRange -> {{-r, r}, {-r, r}, {0, l}}, PlotPoints -> 10],
  ViewPoint -> {Pi, Pi/2, 2}
  ]
 ]

enter image description here

In general, if you're working with regions a lot, I would recommend sticking with equations and inequalities and using Reduce to manipulate them. In your scenario, I found that RegionIntersection gave me very little that I could actually work with. That could well be problems with how I was using it, and there might be a way to get it to work. But I've found that, while occasionally useful, the Region functionality can be pretty limited when it comes to manipulating regions in certain situations. (Not that you were using the Region functionality -- this is a critique of my earlier comment, not the approach you used in your question.)

$\endgroup$
  • $\begingroup$ I would certainly not have stumbled across that! Evaluate@RegionMember[TransformedRegion[ImplicitRegion[ I agree, Region has its uses but is a bit limited. Yours is a very effective and adaptable solution. Much appreciated! $\endgroup$ – DrBubbles Aug 22 '17 at 21:45
  • $\begingroup$ @DrBubbles Glad you liked it. It was an interesting (if a little frustrating) problem. $\endgroup$ – aardvark2012 Aug 22 '17 at 22:33

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.