5
$\begingroup$

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

enter image description here

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?

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – b3m2a1 Jul 6 '18 at 5:44
  • $\begingroup$ For BubbleChart3D there is no such option BoxRatios. However, this option is used, which in itself is funny. $\endgroup$ – Alex Trounev Jul 6 '18 at 5:44
  • $\begingroup$ @AlexTrounev it's available for all Graphics3D-type objects $\endgroup$ – b3m2a1 Jul 6 '18 at 5:46
  • $\begingroup$ This is used, but this should be described in the options, but there is no such option for BubbleChart3D $\endgroup$ – Alex Trounev Jul 6 '18 at 5:52
  • $\begingroup$ @AlexTrounev the documentation leaves out most duplicated options. Check out: Options[BubbleChart3D, BoxRatios]. It'll show you that it is, in fact, and option. $\endgroup$ – b3m2a1 Jul 6 '18 at 6:09
6
$\begingroup$

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, ∞}]] &;

addMetaData[data_, bsizes_] := data -> {MinMax[data[[All, -1]]], bsizes};

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], 
  BubbleChart3D[addMetaData[pts1, bsizes], ImageSize -> 200, 
   BoxRatios -> boxRatio1, PlotRange -> plotRange1, 
   ChartElementFunction -> cef2[boxRatio1, plotRange1]]}]

enter image description here

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

enter image description here

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

enter image description here

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

enter image description here

Original answer:

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

enter image description here

$\endgroup$
  • $\begingroup$ 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? $\endgroup$ – H42 Jul 6 '18 at 16:21
  • $\begingroup$ @HMC, good catch. I will update with a fix. $\endgroup$ – kglr Jul 6 '18 at 20:39
  • $\begingroup$ thanks. I amended my question to append my previous work on cef. You may use that to save effort. Thanks. $\endgroup$ – H42 Jul 6 '18 at 20:51
  • $\begingroup$ @HMC, does the version in update 2 work in your version/os? $\endgroup$ – kglr Jul 11 '18 at 17:41
  • $\begingroup$ 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! $\endgroup$ – H42 Jul 11 '18 at 18:03

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.