Using RegionFunction on a Polar Parametric Equation to Slice Surface in R3

Question

I'm doing a visual graphing project in Mathematica and am building a rose. I've made most of it by slicing different regions of rotation using RegionFunction->[{x,y,z},x^2+y^2<4}]. Instead of using a cylinder, I know want to use different cylinder that would be created when I parametrize: ParametricPlot3D[{(1 + 1/10 Sin[20 t]^2) Cos[t], (1 + 1/10 Sin[20 t]^2) Sin[t], z}, {t, 0, 2 Pi}, {z, -2, 2}]

I want to use this perforated cylinder as a RegionFunction/ to cut out a region of the curve RevolutionPlot3D[x = 6 (Sin[y^2*1/3 + 1])*1/5, {y, 0, 2.3}, Mesh -> None, RevolutionAxis -> {1, 0, 0}]

How do I go about doing this with a parametric equation? I've tried ParametricRegion and RegionFunction, but nether are working. Any ideas would be much appreciated!

Thank you thank you!

Answer 1

It seems no general way to draw the intersection of two parametric surfaces.

Method-1

• At first we re-write the cylinder equation to the parametric form.

Clear[plot1, plot2]; 
plot1 = 
 ParametricPlot3D[{x, (6 (Sin[x^2*1/3 + 1])*1/5)*
    Cos[s], (6 (Sin[x^2*1/3 + 1])*1/5)*Sin[s]}, {x, -2.3, 2.3}, {s, 0,
    2 π}, PlotStyle -> {Opacity[.8], Red}, Mesh -> None];
plot2 = ParametricPlot3D[{(1 + 1/10 Sin[20 t]^2) Cos[
      t], (1 + 1/10 Sin[20 t]^2) Sin[t], z}, {t, 0, 2 Pi}, {z, -2, 2},
    PlotPoints -> 50, MaxRecursion -> 4, Boxed -> False, 
   Axes -> False, Mesh -> None, PlotStyle -> Blue];
Show[plot1, plot2]

• After that we solve the equation to calculate the intersection.

Clear[x, y, z1, z2, sol];
x = (1 + 1/10 Sin[20 t]^2) Cos[t];
y = (1 + 1/10 Sin[20 t]^2) Sin[t];
sol = Solve[(6 (Sin[x^2*1/3 + 1])*1/5)*Cos[s] == y, s];
z1 = (6 (Sin[x^2*1/3 + 1])*1/5)*Sin[s] /. sol[[1]] // Simplify;
z2 = (6 (Sin[x^2*1/3 + 1])*1/5)*Sin[s] /. sol[[2]] // Simplify;
curve = ParametricPlot3D[{{x, y, z1 /. C[1] -> 0}, {x, y, 
     z2 /. C[1] -> 0}}, {t, 0, 2 π}, PlotStyle -> {Blue, Blue}, 
   PlotRange -> All, PlotPoints -> 80, MaxRecursion -> 4, 
   Boxed -> False, Axes -> False, ViewProjection -> "Orthographic"];
Show[curve, plot1, ViewPoint -> #] & /@ {Above, Front, {1, 1, 1}}

Method-2 : Clip the surface by polar region.

Clear[plot, reg, member];
 plot = 
 ParametricPlot[{(1 + 1/10 Sin[20 t]^2) Cos[
     t], (1 + 1/10 Sin[20 t]^2) Sin[t]}, {t, 0, 2 Pi}, 
  PlotPoints -> 200, MaxRecursion -> 4];
reg = BoundaryDiscretizeGraphics[plot, MaxCellMeasure -> .001, 
   AccuracyGoal -> 3];
member = 
 RegionMember[reg]; 
ParametricPlot3D[{x, (6 (Sin[x^2*1/3 + 1])*1/5)*
   Cos[s], (6 (Sin[x^2*1/3 + 1])*1/5)*Sin[s]}, {x, -2.3, 2.3}, {s, 0, 
  2 π}, PlotPoints -> 200, MaxRecursion -> 6, Mesh -> Automatic, 
 MeshStyle -> White, 
 RegionFunction -> Function[{x, y}, member@{x, y}], PlotStyle -> Red, 
 Boxed -> False, Axes -> False, 
 BoundaryStyle -> Directive[AbsoluteThickness[4], Blue]]