# How to recreate this 3D plot?

In other languages, one can make a FeaturePlot3D-esque graphics where the inset images look realistically three dimensional. Meaning that they are smaller when farther away (and also hazier).

So how can we exactly recreate this clustering of mnist:

Is there a way to recreate this effect in Graphics3D or FeaturePlot3D? Even trying the naive example above actually makes the front-end hang:

FeatureSpacePlot3D[ResourceData["MNIST"][[All, 1]], Method -> "TSNE"]
• You can get a better sense of geometrical perspective by adjusting the effective viewing distance, e.g., between Viewpoint -> {1,1,1} and {10,10,10}. Mathematica does not render lighting and shadows, so you'll never get the kind of realism of software designed for true computer graphics. Aug 16, 2018 at 18:31
• So you've found time to set a bounty but not to respond to my comment. Which is confusing because that would clarify what is a valid answer here.
– Kuba
Aug 30, 2018 at 5:30
• Is it about the performance? What is missing?
– Johu
Aug 30, 2018 at 10:22
• It's about being able to recreate the exactly styling and look
– M.R.
Aug 30, 2018 at 14:42
• If you stack a Image3D instance with Graphics3D, it will emulate fog effect. It was asked before, I but forgot where. Sep 2, 2018 at 11:35

data = RandomSample[ResourceData["MNIST", "TestData"], 1000];
pts = DimensionReduce[data[[All, 1]], 3, Method -> "TSNE"];
imgs = data[[All, 1]]; classes = data[[All, 2]]; pr = MinMax /@ Transpose[pts];
mm = MinMax[(1/EuclideanDistance[{pr[[1, 2]], pr[[2, 1]], pr[[3, 2]]}, #]) & /@ pts];
vp = {1.3, -2.4, 2.`}; vp = {0, -2, 2};
ir[pt : {x_, y_, z_}, img_, class_] := {Opacity[1],
Glow[ColorData["Rainbow"][(class + 1)/10.]],
Texture[ImageMultiply[img, ColorData["Rainbow"][(class + 1)/10.]]], EdgeForm[{Thin}],
Tooltip[GeometricTransformation[
GeometricTransformation[GeometricTransformation[
Polygon[{{-1, -1, 0}, {1, -1, 0}, {1, 1, 0}, {-1, 1, 0}},
VertexTextureCoordinates -> {{0,
0}, {1, 0}, {1, 1}, {0, 1}}],
TranslationTransform[{x, y, z}]],
RotationTransform[45 \[Degree], {1, 0, 1}]],
ScalingTransform[{1, 1, 1}]], pt]};
g = Graphics3D[MapThread[ir, {pts, imgs, classes}],
ImageSize -> 400, Axes -> True, AxesLabel -> {"x", "y", "z"}]

• What about the cloudiness? And smooth framerates? Nov 5, 2019 at 3:59
• That’s currently beyond Mathematica’s abilities, this is the best you’ll get
– M.R.
Nov 5, 2019 at 4:01

The simple way is combination of some 3D objects by Show like following: 1. Lets make the 3D-shift functions defining the positions of objects in joint figure (+-0.25 in X-direction and 0.25 in Y-dir.):

shift = {#[[1]] + 0.25, #[[2]], #[[3]]} &;
shift2 = {#[[1]] - 0.25, #[[2]] + 0.25, #[[3]]} &;

Next, let's take the samples of 3D shapes from Wolfram:

sample1 = shift /@ ExampleData[{"Geometry3D", "StanfordBunny"},"VertexData"];
sample2 = shift2 /@ ExampleData[{"Geometry3D", "Cow"}, "VertexData"];

And draw them:

Show[
ListSurfacePlot3D[sample1, MaxPlotPoints -> 50, PlotStyle -> Red],
ListSurfacePlot3D[sample2, MaxPlotPoints -> 55]
]

Sorry, but cow looks ill :)

• The cow looks less ill when you use the respective MeshRegions: Show[ MeshRegion[ Translate[ ExampleData[{"Geometry3D", "StanfordBunny"}, "MeshRegion"], {0.25, 0., 0.} ], MeshCellStyle -> {{2, All} -> Directive[FaceForm[ColorData[97][4]]]} ], MeshRegion[ Translate[ ExampleData[{"Geometry3D", "Cow"}, "MeshRegion"], {-0.25, 0.25, 0.} ], MeshCellStyle -> {{2, All} -> Directive[FaceForm[ColorData[97][1]]]} ] ]. But I doubt that this will answer OP's question. Aug 30, 2018 at 6:05
• Mathematica also has built in commands for coordinate transformations, like Translate.
– Johu
Aug 30, 2018 at 10:23
• @HenrikSchumacher, The perspective can be added directly clicking onto the plot. All rest looks like described in OP. Aug 30, 2018 at 13:56
• @Rom38 I guess, OP's question was more about the fog. That's funny because we all remember these 3D-games from the 90s where all this fog was necessary only because of poor hardware. ^^ Aug 30, 2018 at 15:07