8
$\begingroup$

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:

plot

(It is the last plot on this page.)

Improve this question
$\endgroup$
1
  • 1
    $\begingroup$ 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.) $\endgroup$
    – C. E.
    Commented Sep 22, 2013 at 12:51

2 Answers 2

Reset to default
7
$\begingroup$ 
(*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"]]]

Mathematica graphics

Improve this answer
$\endgroup$
5
$\begingroup$ 
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]]

Mathematica graphics

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?

Improve this answer
$\endgroup$
2
  • $\begingroup$ Kindly explain me, is there any reason of taking function equal to some constant like you have taken? $\endgroup$
    – physicist
    Commented Sep 22, 2013 at 17:27
  • 2
    $\begingroup$ @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. $\endgroup$
    – Michael E2
    Commented Sep 22, 2013 at 17:44

Not the answer you're looking for? Browse other questions tagged or ask your own question.