How to recreate this 3D plot?

Question

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. — David G. Stork, Aug 16 '18 at 18:31
Considering view point as a minor part, it looks like a duplicate: https://mathematica.stackexchange.com/q/55174/5478, do you agree? — Kuba, Aug 20 '18 at 06:16
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 '18 at 05:30
It's about being able to recreate the exactly styling and look — M.R., Aug 30 '18 at 14:42
@Kuba sorry I missed your comment! So the beautiful plot shown above has a depth and a feel (which is lacking in FeatureSpacePlot3D) that I would like to be able to recreate - I'm sure this can be partially done with texture and view angle, but I was hoping for an inspiring answer... — M.R., Aug 30 '18 at 16:14
If you stack a Image3D instance with Graphics3D, it will emulate fog effect. It was asked before, I but forgot where. — kh40tika, Sep 02 '18 at 11:35
Put an InfinitePlane colored like GrayLevel[0, .1] in the y-z plane and you can make this type of thing happen I think. — b3m2a1, Sep 04 '18 at 05:58
@kh40tika Cool! Indeed, that "works". But it is awfully slow... =/ — Henrik Schumacher, Sep 05 '18 at 18:04

score 3 · Accepted Answer · answered Nov 04 '19 at 17:10

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"}]

That’s currently beyond Mathematica’s abilities, this is the best you’ll get — M.R., Nov 05 '19 at 04:01

score -3 · Answer 2 · answered Aug 30 '18 at 05:55

-3

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 :)

answered Aug 30 '18 at 05:55

Rom38

5,129
13
28

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. – Henrik Schumacher Aug 30 '18 at 06:05
Mathematica also has built in commands for coordinate transformations, like Translate. – Johu Aug 30 '18 at 10:23
@HenrikSchumacher, The perspective can be added directly clicking onto the plot. All rest looks like described in OP. – Rom38 Aug 30 '18 at 13:56
2

@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. ^^ – Henrik Schumacher Aug 30 '18 at 15:07

How to recreate this 3D plot?

2 Answers2