ColorFunction and/or ColorScaling issue with ParametricPlot3D
Main thing to know is that for ColorData["TemperatureMap"][f[x]]
you must have 0 < f < 1
. What ColorFunctionScaling
does - it rescales range x
, and you need to rescale domain f
.
I will consider a simplified case of your problem and you can generalize. Let's take t = 0.5 Stripping your function u of unneeded variables, you have:
u[y_,t_]=(-8*(2 - Pi)*Cos[(Pi*y)/4])/(E^((Pi^2*t)/20)*Pi^2) -
(8*(2 + 3*Pi)*Cos[(3*Pi*y)/4])/(9*E^((Pi^2*t)/5)*Pi^2) -
(8*(2 - 5*Pi)*Cos[(5*Pi*y)/4])/(25*E^((9*Pi^2*t)/20)*Pi^2)
Let's plot its original and re-scaled forms:
{min, max} = {NMinValue[#, y], NMaxValue[#, y]} &@{u[y, .5], 0 < y < 2}
{1.29488*10^-16, 0.789722}
Plot[{u[z, .5], (u[z, .5] - min)/(max - min)}, {z, 0, 2}, PlotRange -> All, Filling -> 0]
You can see the difference. Now, the correct cylinder for t = 0.5 is set up like this - and you can see exact correspondence to your rectangle pictures:
GraphicsRow[{
ParametricPlot3D[{Cos[theta], Sin[theta], z}, {theta, -Pi, Pi}, {z, 0, 2},
AxesLabel -> {x, y, z}, ColorFunctionScaling -> False,
ColorFunction -> Function[{x, y, z, m, n},
ColorData["TemperatureMap"][Rescale[u[z, .5], {min, max}]]],
Mesh -> 8, MeshFunctions ->
Function[{x, y, z, m, n}, Rescale[u[z, .5], {min, max}]]],
ContourPlot[u[y, .5], {x, -Pi, Pi}, {y, 0, 2},
ColorFunction -> ColorData["TemperatureMap"], Contours -> 8]}]
You can get the colors from the 2D contour plots and use them as the setting for MeshShading
:
tt = {0, .1, .3, .5, 1, 2, 3, 4};
cps = Table[ContourPlot[u[x, y, t], {x, -a, a}, {y, 0, b},
ColorFunction -> ColorData["TemperatureMap"], Contours -> 8], {t, tt}];
colors = Cases[cps[[#]], _RGBColor, Infinity] & /@ Range[8];
Then
Grid[Partition[Table[ParametricPlot3D[{Cos[theta], Sin[theta], rho},
{theta, -Pi, Pi}, {rho, 0, 2},
Mesh -> 8,
MeshFunctions -> {Function[{x, y, z, theta, rho}, u[x, z, tt[[i]]]]},
MeshShading -> colors[[i]],
ColorFunction -> Function[{x, y, z, theta, rho},
ColorData["TemperatureMap"][u[x, z, tt[[i]]]]],
AxesLabel -> {x, y, z}], {i, Range[8]}], 4]]
gives
I figured that since the question's been answered anyway, I'd illustrate the Texture[]
alternative, which completely avoids the rigamarole of having to find the extrema of the coloring function:
a = π; b = 2;
f[x_, y_] := y;
u[x_, y_, t_] := -((8 E^(-((π^2 t)/20)) (2 - π) Cos[(π y)/4])/π^2) -
(8 E^(-((π^2 t)/5)) (2 + 3 π) Cos[(3 π y)/4])/(9 π^2) -
(8 E^(-((9 π^2 t)/20)) (2 - 5 π) Cos[(5 π y)/4])/(25 π^2);
tex = With[{t = 0.5},
Image[ContourPlot[u[x, y, t], {x, -a, a}, {y, 0, b},
AspectRatio -> Automatic, ColorFunction -> "TemperatureMap",
Contours -> 8, Frame -> None, ImagePadding -> None,
PlotRange -> All, PlotRangePadding -> None],
ImageResolution -> 256]];
ParametricPlot3D[{Cos[θ], Sin[θ], ρ}, {θ, -a, a}, {ρ, 0, b},
AxesLabel -> {x, y, z}, Lighting -> "Neutral",
Mesh -> None, PlotStyle -> Texture[tex],
ViewPoint -> {-2.3, 0.77, -2}, ViewVertical -> {-0.08, 1, -0.06}]
I'll leave the generalization as an exercise for the interested reader.