12
$\begingroup$

I would like to have the filling of my ListPlot3D display the same color than the one applied to the data. This question makes sense only in the case of conditional coloring of data (according to their height for example). Moreover, I am using the option InterpolationOrder -> 0 and I understand what I ask is kind of tricky in case of higher orders.

Here is a minimal example

table = {{1, 2, 1, 2}, {3, 1, 3, 2}, {4, 3, 4, 2}, {1, 2, 3, 4}};
ListPlot3D[
    table, 
    InterpolationOrder -> 0,
    ColorFunction -> "DarkRainbow", 
    Filling -> Axis,
    FillingStyle -> {Opacity[1]}, Mesh -> None
    ]

which gives gray filling beneath the data.

My question is the following :

Is it possible to specify a dynamic color in the FillingStyle so that it will match the data ?

$\endgroup$
10
$\begingroup$

If nobody comes with a much cleverer solution, this might be a way to achieve what you're looking for. However, first your data have to be reshaped.

newtable = {{1, 2, 1}, {3, 1, 3}, {4, 3, 4}};
BarChart3D[newtable, ChartLayout -> "Grid", 
    ViewPoint -> {3.33, -8.26, 5.36}, ColorFunction -> "DarkRainbow", 
    Method -> {"Canvas" -> None}]

plot1

With some additional options:

BarChart3D[newtable, ChartLayout -> "Grid", ChartElementFunction -> "Cube",
    ViewPoint -> {3.33, -8.26, 5.36}, ColorFunction -> "DarkRainbow",
    Method -> {"Canvas" -> None}, BarSpacing -> {None, None}]

plot2

$\endgroup$
  • $\begingroup$ One could indeed say that the use of ListPlot3D is not optimal in my case. I like your solution, especially adding BarSpacing -> {0, 0} $\endgroup$ – Pschoofs Mar 22 '12 at 11:03
10
$\begingroup$

There is also ... DiscretePlot3D

With appropriate settings for the options ExtentSize and ColorFunction you get something similar to BarChart3D:

Two examples:

Row[{
  DiscretePlot3D[table[[i, j]], {i, 1, 4}, {j, 1, 4}, 
   BoxRatios -> {1., 1., .7}, ExtentSize -> Scaled[.75], 
   ColorFunction -> (Hue[#3] &)],
  DiscretePlot3D[table[[i, j]], {i, 1, 4}, {j, 1, 4}, 
   BoxRatios -> {1., 1., .7}, ExtentSize -> Full, 
   ColorFunction -> "Rainbow", 
   ExtentElementFunction -> "ProfileCube"]
 }]

discreteplot3d examples

$\endgroup$
8
$\begingroup$

You could use graphics primitives to construct your plot. For example

{min, max} = Through[{Min, Max}[Flatten[table]]];
Graphics3D[
 MapIndexed[{ColorData["DarkRainbow"][Rescale[#1, {min, max}]], 
    Cuboid[Append[#2, 0], Append[#2 + {1, 1}, #1]]} &, table, {2}], 
 Lighting -> "Neutral", Axes -> True]

produces

Mathematica graphics

$\endgroup$
3
$\begingroup$

As usual, when something does not give away itself readily, make your own function from scratch. This topped barchart-like plotter I have built for my own purposes to visualize 5 dimensions of data: $x$ and $y$ position, $z$ height, bar color and top color. I also included the background of BarChart3D as back, but that can be omitted.

(* BarcChart3D background *)
vertex = {Directive[Opacity@.2, RGBColor[1/3, 1/3, 2/3]], 
   Directive[Opacity@.2, RGBColor[1/2, 1/2, 1]], 
   Directive[Opacity@.2, RGBColor[2/3, 2/3, 1]], 
   Directive[Opacity@.2, GrayLevel@1]};
back = {
   EdgeForm@GrayLevel@0.85,
   (* Bottom *)
   Polygon[{Scaled@{0.015, 0.02, 0.02}, Scaled@{0.985, 0.02, 0.02}, 
     Scaled@{0.985, 0.98, 0.02}, Scaled@{0.015, 0.98, 0.02}}, 
    VertexColors -> vertex],
   Polygon[{Scaled@{0.015, 0.02, 0.02}, Scaled@{0.985, 0.02, 0.02}, 
     Scaled@{1, 0, 0}, Scaled@{0, 0, 0}}, VertexColors -> vertex],
   Polygon[{Scaled@{0.985, 0.02, 0.02}, Scaled@{1, 0, 0}, 
     Scaled@{1, 1, 0}, Scaled@{0.985, 0.98, 0.02}}, 
    VertexColors -> vertex],
   Polygon[{Scaled@{0.015, 0.98, 0.02}, Scaled@{0.985, 0.98, 0.02}, 
     Scaled@{1, 1, 0}, Scaled@{0, 0.99, 0}}, VertexColors -> vertex],
   Polygon[{Scaled@{0.015, 0.02, 0.02}, Scaled@{0, 0, 0}, 
     Scaled@{0, 0.99, 0}, Scaled@{0.015, 0.98, 0.02}}, 
    VertexColors -> vertex],
   Polygon[{Scaled@{0, 0, 0}, Scaled@{1, 0, 0}, Scaled@{1, 1, 0}, 
     Scaled@{0, 0.99, 0}}, VertexColors -> vertex],
   (* Back *)
   Polygon[{Scaled@{0.015, 0.98, 0.02}, Scaled@{0.985, 0.98, 0.02}, 
     Scaled@{0.985, 0.98, 0.98}, Scaled@{0.015, 0.98, 0.98}}, 
    VertexColors -> vertex],
   Polygon[{Scaled@{0.015, 0.98, 0.02}, Scaled@{0.985, 0.98, 0.02}, 
     Scaled@{1, 1, 0}, Scaled@{0, 0.99, 0}}, VertexColors -> vertex],
   Polygon[{Scaled@{1, 1, 0}, Scaled@{1, 1, 1}, 
     Scaled@{0.985, 0.98, 0.98}, Scaled@{0.985, 0.98, 0.02}}, 
    VertexColors -> vertex],
   Polygon[{Scaled@{0.015, 0.98, 0.98}, Scaled@{0.985, 0.98, 0.98}, 
     Scaled@{1, 1, 1}, Scaled@{0, 1, 1}}, VertexColors -> vertex],
   Polygon[{Scaled@{0.015, 0.98, 0.02}, Scaled@{0, 0.99, 0}, 
     Scaled@{0, 1, 1}, Scaled@{0.015, 0.98, 0.98}}, 
    VertexColors -> vertex],
   Polygon[{Scaled@{0, 0.99, 0}, Scaled@{1, 1, 0}, Scaled@{1, 1, 1}, 
     Scaled@{0, 1, 1}}, VertexColors -> vertex]
   };


(* define some data of 4 dimensions: x, y, z height and top color *)
{m, n} = {10, 6};
data = Partition[Sort@Table[{RandomReal[], RandomReal[]}, {m*n}], n];

(* {z and top color position in data entries, horizontal and vertical gaps} *)
{z, top, hGap, vGap} = {1, 2, 0.075, 1/1000};

(* let's plot the whole thing *)
Graphics3D[
 Join[{back},
  Flatten@Table[{
     Opacity@0.5, EdgeForm@None, FaceForm@Hue@data[[x, y, z]], 
     Cuboid[{y - .5 + hGap, x - .5 + hGap, 0}, {y + .5 - hGap, 
       x + .5 - hGap, data[[x, y, z]]}],(* bar *)
     Opacity@1.0, EdgeForm@Black, FaceForm@Hue@data[[x, y, top]], 
     Cuboid[{y - .5 + hGap, x - .5 + hGap, 
       data[[x, y, 1]] + vGap}, {y + .5 - hGap, x + .5 - hGap, 
       data[[x, y, z]] + vGap}] (* top *)
     }, {x, m}, {y, n}]]
 ,
 BoxRatios -> 1, PlotRange -> All, Boxed -> False, Axes -> True
 ]

Mathematica graphics

It might need some fiddling with axes, plot ranges and similar.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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