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

This question already has an answer here:

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: (It is the last plot on this page.)

## marked as duplicate by Mr.Wizard♦Sep 23 '13 at 13:03

This question has been asked before and already has an answer. If those answers do not fully address your question, please ask a new question.

• 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.) – C. E. Sep 22 '13 at 12:51

## 2 Answers

(*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[], {min, max}];
plot /.
GraphicsComplex[pts_, g_, stuff__] :>
With[{minmax = {Min[#], Max[#]} &@pts[[All, 3]]},
GraphicsComplex[pts,
Point[pts, VertexColors -> (cf[#, minmax] & /@ pts)], stuff]] See also the following, which are related if not duplicates:

Plot 4D data with color as 4th dimension

What are the possible ways of visualizing a 4D function in Mathematica?

• Kindly explain me, is there any reason of taking function equal to some constant like you have taken? – physicist Sep 22 '13 at 17:27
• @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. – Michael E2 Sep 22 '13 at 17:44