2
$\begingroup$

I want to draw temperature 3D plot based on given data points {{x1,y1,z1},{x2,y2,z2},...}. Here z coordinate is temperature.Am going to Show the temperature z in corresponding {x,y} coordinate. In my example i used only 11 points. I tried like this.

list = {};
width = 50;
length = 30;
place = { {20, 4, 20}, {20, 10, 10}, {20, 15, 10}, {20, 19, 15}, {20, 
23, 5}, {20, 27, 60}, {40, 5, 50}, {40, 10, 30}, {40, 19, 
20}, {40, 27, 40}, {45, 10, 35}};
Table[AppendTo[list, Table[0, {x, width}]], {y, length}];
    Table[
                list = ReplacePart[list, {{y, x} -> place[[n, 3]]}],
                {n, Length[place]}, {y, place[[n, 2]] - 1,place[[n, 2]] + 1}, {x, place[[n, 1]] - 1, place[[n, 1]] + 1}
        ];
ListPlot3D[list, Mesh -> 10, AxesLabel -> {x, y, z},RotationAction -> "Clip"]

Here i have given the data is x coordinate, y coordinate and z coordinate(temperature). Sub list {x,y,z} represent each point. In this manner, I want to create 1000 to 1500 points that are laid out in the plot with gap between each point shown clearly.

I have specified length and width of plot as 50 and 30 respectively. The problem am facing is i can't layout all(1000 to 1500) points in 50*30 dimension of Plot, even if i place all the points in 50*30 dimension plot the gap between each point is not shown clearly.

If i increase the dimension of list from 50 to 500 and 30 to 300 means 500*300, i will get the output but its really slow. Because 500*300 leads 150,000 data which makes the plot slow.

In this plot i have used ReplacePart[] function to replace 0 with given temperature and i have used table to span from previous point of current point to next point of current point means -1 to 1(three points).

$\endgroup$

2 Answers 2

4
$\begingroup$

If you want to show the data points separately, then ListPlot3D is probably not the way to go. How about using ListPointPlot3D with filling?

(* example data *)
place = {#1, #2, Sin[0.01 #1 #2]^2} & @@@ Tuples[Range[10], 2];

ListPointPlot3D[place, Filling -> Axis, PlotStyle -> PointSize[Large],
  FillingStyle -> Thick, PlotRange -> All]

enter image description here

or just create your own Graphics3D directly:

Graphics3D[
 Cuboid[{#1 - 0.3, #2 - 0.3, 0}, {#1 + 0.3, #2 + 0.3, #3}] & @@@ 
  place, Axes -> True, BoxRatios -> {1, 1, 0.5}]

enter image description here

$\endgroup$
3
$\begingroup$

Recycling this answer to a related question,

Using DiscretePlot2D and Interpolation:

dta1 = Array[{#1, #2, 0} &, {50, 30}];
replaceRl = (Join[#[[;; 2]], {0}] -> #) & /@ place;
dta2 = dta1 /. replaceRl;
intF = Interpolation[Join @@ dta2];
DiscretePlot3D[intF[i, j], {i, 1, 50}, {j, 1, 30}, ColorFunction -> "Rainbow",
 ExtentSize -> Scaled[.75],  BoxRatios -> {1, 1, 1/2},  ImageSize -> 500]

enter image description here

Using BubbleChart3D:

bchrtdata = Append[#, 1] & /@ (Join @@ dta2);
ceFunc[{{xmin_, xmax_}, {ymin_, ymax_}, {zmin_, zmax_}}, v_,  meta_] :=
  {Cuboid[{xmin, ymin, 0.}, {xmax, ymax, (zmax + zmin)/2}]};
BubbleChart3D[bchrtdata,  ColorFunction -> (ColorData["Rainbow"][#3] &), 
  ChartStyle -> Opacity[.9], ChartElementFunction -> ceFunc,
  BubbleSizes -> {0.01, .01}, BoxRatios -> {1, 1, 1/2}, ImageSize -> 500]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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