# Polar coordinate transformation

I have a function in polar coordinate f[\[Theta],\[Phi]] = 1 + 2 Cos[2 \[Theta]]. The function is centered at the origin. Is there a way to plot another function of the same shape but centered at (1,0,0), i.e. shifted along x-axis? What I want is to have two functions of identical shape centered at (0,0,0) and (1,0,0) respectively but I only have the explicit form of the function at (0,0,0).

SphericalPlot3D[1 + 2 Cos[2 \[Theta]],
{\[Theta], 0, Pi}, {\[Phi], 0, 2 Pi}]


EDIT: Changed colors and corrected color issues.

sp3d = SphericalPlot3D[
1 + 2 Cos[2 θ], {θ, 0, Pi}, {ϕ, 0, 2 Pi},
ColorFunction ->
Function[{x, y, z, θ, ϕ, r},
Piecewise[{{Red, 1 + 2 Cos[2 θ] < 0}}, Lighter@Orange]],
ColorFunctionScaling -> False,
PlotPoints -> 25,
MaxRecursion -> 3];

Manipulate[
Show[
sp3d,
ReplacePart[
sp3d, {1, 1} ->
sp3d[[1, 1]] /. {x_?NumericQ, y_?NumericQ, z_?NumericQ} :> {x + offset,
y, z}],
PlotRange -> All], {{offset, 1}, 0, 3, 0.25, Appearance -> "Labeled"}] • Thanks. Your solution runs much faster. Can you explain your solution a bit? /. is the replaceall operator and :> is rule delayed. What does _?NumericQ do here? Thanks. – yquan Nov 7 '18 at 20:44
• It restricts the lists that are translated by {0, 0, 1} to those whose third coordinate is a numeric value. The first two coordinates are already restricted to being numeric by being bound to within the interval {-1, 1}. The Graphics3D contains other lists of length three that are not points and should not be translated. – Bob Hanlon Nov 7 '18 at 21:20
• How to change the color setting so that the plot is yellow when 1+2Cos[[Theta]] is positive and red for negative? Thanks again. – yquan Nov 7 '18 at 23:59

First generate data points from your function:

data = Flatten[
Table[{1 + 2 Cos[2 \[Theta]], \[Theta], \[Phi]},
{\[Theta], 0, Pi, Pi/500}, {\[Phi], 0, 2 Pi, 2 Pi/500}], 1];


Next a mapping from polar to cartesian:

mapping =
CoordinateTransformData["Spherical" -> "Cartesian", "Mapping"];


now the points (transformed) with offset of {1,0,0}:

ListPointPlot3D[# + {1, 0, 0} & /@ (mapping /@ data),
BoxRatios -> Automatic] or

ListSurfacePlot3D[# + {1, 0, 0} & /@ (mapping /@ data),
MaxPlotPoints -> 60,
BoxRatios -> Automatic] Both together:

mappeddata = mapping /@ data;
plt1 = ListSurfacePlot3D[# + {1, 0, 0} & /@ mappeddata,
MaxPlotPoints -> 30, PlotStyle -> {Opacity[0.5], Red}];
plt2 = ListSurfacePlot3D[mappeddata,
MaxPlotPoints -> 30, PlotStyle -> {Opacity[0.5], Blue}];
Show[plt1, plt2] • Thanks. Could you post the code for plotting two functions at the same time using ListSurfacePlot3D? I tried ListSurfacePlot3D[{# & /@ (mapping /@ data), # + {1, 0, 0} & /@ (mapping /@ data)}, MaxPlotPoints -> 60, BoxRatios -> Automatic]. But it doesn't work. Thanks again. – yquan Nov 7 '18 at 20:22

For exact copies apply Translate to the graphics elements, which are in position 1 of the graphics returned by plotting functions:

g = SphericalPlot3D[1 + 2 Cos[2 θ], {θ, 0, Pi}, {ϕ, 0, 2 Pi}];
vecs = {{0, 0, 0}, {1, 0, 0}};

Show[MapAt[Translate[#, vecs] &, g, 1], PlotRange -> All] It's very efficient, as g is computed once, only one copy is stored, and the translations are computed by the GPU (I think).

vecs = 2 Tuples[{Range[0, 3], Range[0, 2], {0}}];
g12 = Show[MapAt[Translate[#, vecs] &, g, 1], PlotRange -> All] ByteCount /@ {g, g12}
(*  {697504, 698024}  *)

• Thanks for your answer. – yquan Nov 10 '18 at 0:51
• @yquan You're welcome. – Michael E2 Nov 10 '18 at 1:51