# Need 4D plot (3D + color for function) [duplicate]

I have a function f(x,y,z) of three variables and some constants:

P1 = 630*10^6;
a1 = 6.1;
deltaf = 680*10^-28;
rho = 13600;
Na = 6.03*10^23;
M = 270;
N1 = rho*Na/M;
sigmaf = N1*deltaf;
v1 = 161/(0.7958)^3;
Ef = 3.2*10^-11;
A1 = 3.87*P1/(v1*Ef*sigmaf);

flux1[x_, y_, z_] :=   A1*Cos[\[Pi]*x/a1]*Cos[\[Pi]*y/a1]*Cos[\[Pi]*z/a1];


I want to plot this function in 3D frame with color to represent the value of a f(x,y,z) at each triplet point. And need color bar to show variation. Give me suggestions.

I have used the following command but it is not working properly.

ContourPlot3D[
A1*Cos[\[Pi]*x/a1]*Cos[\[Pi]*y/a1]*Cos[\[Pi]*z/a1], {x, -3,
3}, {y, -3, 3}, {z, -3, 3},
ColorFunction -> (ColorData["TemperatureMap"][#3] &)]


I want the plot to look like this:

• That plot is generated by drawing a surface and making the color with each point on that surface correspond to some function value. What is the surface in your case? (i.e. allowed triplets.) Commented Sep 22, 2013 at 12:51

(*Setup sample functions*)
p[m1_, m2_, s1_, s2_] := PDF[BinormalDistribution[{m1, m2}, {s1, s2}, 0], {x, y}];
k[x_, y_] := Evaluate@Total@ Array[(RandomReal[{-1, 1}]) p[RandomReal[], RandomReal[],
RandomReal[{.3, .5}], RandomReal[{.3, .5}]] &, 5]
flux1[x_, y_, z_] := TriangleWave@x;

(*now the actual code*)
d = Flatten[Table[{x, y, k[x, y], flux1[x, y, z]}, {x, -2, 2, .05}, {y, -2,  2, .05}], 1];
d1 = Transpose[Rescale /@ Transpose[d]];
Block[{i = 1},
ListPointPlot3D[d1[[All, ;; 3]], PlotRange -> All,
ColorFunction ->  Function[{x, y, z}, ColorData["TemperatureMap"][d1[[i++, 4]]]],
PlotLegends -> BarLegend["TemperatureMap"]]]


P1 = 630*10^6;
a1 = 6.1;
deltaf = 680*10^-28;
rho = 13600;
Na = 6.03*10^23;
M = 270;
N1 = rho*Na/M;
sigmaf = N1*deltaf;
v1 = 161/(0.7958)^3;
Ef = 3.2*10^-11;
A1 = 3.87*P1/(v1*Ef*sigmaf);
plot = ContourPlot3D[
A1*Cos[Pi*x/a1]*Cos[Pi*y/a1]*Cos[Pi*z/a1] ==
0.5 A1, {x, -3, 3}, {y, -3, 3}, {z, -3, 3}, PlotPoints -> 11,
Mesh -> None, PlotLegends -> BarLegend["TemperatureMap"]];

cf[p_, {min_, max_}] :=
ColorData["TemperatureMap"]@Rescale[p[[3]], {min, max}];
plot /.
GraphicsComplex[pts_, g_, stuff__] :>
With[{minmax = {Min[#], Max[#]} &@pts[[All, 3]]},
GraphicsComplex[pts,
Point[pts, VertexColors -> (cf[#, minmax] & /@ pts)], stuff]]


• @physicist ContourPlot3D by default produces several such layers -- in this case they are all inside one another. It produces many, many points, which fill the image so that it looks solid. Adding == 0.5 A1 shows only one layer, which I think produces a more effective image. That judgment depends on one's goals, so feel free to disagree. :) The linked questions show other methods to approach the kind of thing you're trying to do. Perhaps one of those alternatives would be more suitable. Commented Sep 22, 2013 at 17:44