How to force the ellipsoid of BubbleChart3D to be spherical when the BoxRatios is rectangular?

I have a BubbleChart3D as below, while the BoxRatio is rectangular:

BlockRandom[SeedRandom[123];
pts1 = RandomReal[1, {10, 4}];
pts2 = RandomReal[10, {10, 4}];]
BubbleChart3D[{pts1, pts2}, BoxRatios -> {0.5, 1.5, 2}]


As you can see, the points are ellipsoids instead of spheres. How can I force the points to become spherical again?

Many thanks!

Many thanks for the reply. But I may need to add a subsequent section for the question, as the situation is so odd: whenever I changed my data, the shape of the sphere can be changed from sphere back to ellipsoid.

I try to simplify my current work as below:-

k = 10;
BlockRandom[SeedRandom[123]; pts0 = RandomReal[10, {k, 4}];]

pts1 = pts0;
pts1[[All, 1]] = pts0[[All, 1]] + (x1 = -50);
pts1[[All, 2]] = pts0[[All, 2]] + (x2 = 80);
pts1[[All, 3]] = pts0[[All, 3]] + (x3 = 200);

boxRatio1 = {0.5, 1.5, 2.7};
plotRange1 = {{-70, -30}, {60, 110}, {0, 250}};

cef[br_: {1, 1, 1}, pr_] := (dPr = Flatten@(Differences /@ pr); Scale[ChartElementData["Bubble3D"][##], MapThread[Times, {1.5/br, dPr/Min[dPr]}]] &);

bchart3b = BubbleChart3D[pts1, ImageSize -> 200, BoxRatios -> boxRatio1, ChartElementFunction -> cef[boxRatio1, plotRange1], PlotRange -> plotRange1]


As you can see, when k is 10, the shape of the points are spheres. When k is 9, the shape of the points are ellipsoid...

Why is that?

• I've been trying to do this with post-processing but it's not going great... I can't quite figure out how to make GeometricTransformationBox3D do what I want. Commented Jul 6, 2018 at 5:44
• For BubbleChart3D there is no such option BoxRatios. However, this option is used, which in itself is funny. Commented Jul 6, 2018 at 5:44
• @AlexTrounev it's available for all Graphics3D-type objects Commented Jul 6, 2018 at 5:46
• This is used, but this should be described in the options, but there is no such option for BubbleChart3D Commented Jul 6, 2018 at 5:52
• @AlexTrounev the documentation leaves out most duplicated options. Check out: Options[BubbleChart3D, BoxRatios]. It'll show you that it is, in fact, and option. Commented Jul 6, 2018 at 6:09

Update 2: Finding a fix for that would work for all built-in ChartElementFunctions seems challenging. The following modification of cef works only for "Bubble3D". The function addMetaData attaches the MinMax of the last column of the data and the range of bubble sizes as metadata, and this metadata is used by cef2 in rescaling the sphere primitives.

ClearAll[cef2, addMetaData]
cef2[br_: {1, 1, 1}, pr_: {{0, 1}, {0, 1}, {0, 1}}, sc_: .1] := Module[
{ced = ChartElementData["Bubble3D"][##],
rs = sc Rescale[#2[[-1]], #3[[1, 1]], #3[[1, 2]]] Norm[
Subtract @@ Transpose[pr]] Normalize[-Subtract @@@ pr]/br},
Replace[ced, Scale[a_, b_, c_] :> Scale[a, rs, c], {0, ∞}]] &;

k = 9;
boxRatio1 = {0.5, 1.5, 2.7};
plotRange1 = {{-70, -30}, {60, 110}, {0, 250}};
bsizes = {0.1, .5};
Row[{BubbleChart3D[pts1, ImageSize -> 200, BoxRatios -> boxRatio1,
PlotRange -> plotRange1],
BoxRatios -> boxRatio1, PlotRange -> plotRange1,
ChartElementFunction -> cef2[boxRatio1, plotRange1]]}]


Update: A custom ChartElementFunction that modifies the built-in ones using Scale to remove the distortion:

ClearAll[cef]
cef[br_: {1, 1, 1}][cedf_: "Bubble3D"] := Scale[ChartElementData[cedf][##], 1/br] &;


Examples:

br1 = {0.5, 1.5, 2};
Row[BubbleChart3D[{pts1, pts2}, ImageSize -> 200, BoxRatios -> br1,
ChartElementFunction -> #] & /@ {"Bubble3D", cef[br1][]}]


br2 = {3, 1, 2};
Row[BubbleChart3D[{pts1, pts2}, ImageSize -> 200, BoxRatios -> br2,
ChartElementFunction -> #] & /@ {"Bubble3D", cef[br2][]}]


Row[BubbleChart3D[{pts1, pts2}, ImageSize -> 200, BoxRatios -> br1,
ChartElementFunction -> #] & /@ {"ProfileCube", cef[br1]["ProfileCube"]}]


You can post-process the output of BubbleChart3D to modify the distorted spheres. If you don't mind loosing tooltips (due to the option setting PerformanceGoal -> "Speed"), post-processing becomes easier:

postprocess = # /. Translate[Scale[{a_}, b_, c_], d_] :>
Translate[Scale[{a}, b/(BoxRatios /. Options[#, BoxRatios]), c], d] &;


Example:

bc3d1 = BubbleChart3D[{pts1, pts2}, BoxRatios -> {0.5, 1.5, 2},
PerformanceGoal -> "Speed", ImageSize -> 300];
Row[{bc3d1, postprocess @ bc3d1}]


• Many thanks for your help, and BubbleChart3D[{pts1, pts2}, ImageSize -> 200, BoxRatios -> br1, ChartElementFunction -> cef[br1][]] works well. But when I define the PlotRange like BubbleChart3D[{pts1, pts2}, ImageSize -> 200, BoxRatios -> br1, ChartElementFunction -> cef[br1][], PlotRange -> {{0, 10}, {0, 10}, {0, 40}}], the distortion appears again... How can I combine the change for both BoxRatios and PlotRange into cef?
– H42
Commented Jul 6, 2018 at 16:21
• @HMC, good catch. I will update with a fix.
– kglr
Commented Jul 6, 2018 at 20:39
• thanks. I amended my question to append my previous work on cef. You may use that to save effort. Thanks.
– H42
Commented Jul 6, 2018 at 20:51
• @HMC, does the version in update 2 work in your version/os?
– kglr
Commented Jul 11, 2018 at 17:41
• I just saw the editions you've made 2 days ago, sorry. I will edit it back to my current codes and tested for the several situations previously having problems, and will revert. Many thanks!
– H42
Commented Jul 11, 2018 at 18:03