2
$\begingroup$

I have some codes as below:-

Data points

k = 9;
BlockRandom[SeedRandom[123]; pts0a = RandomReal[10, {k, 4}];]
BlockRandom[SeedRandom[246]; pts0b = RandomReal[10, {k, 4}];]

pts1a = pts0a;
pts1a[[All, 1]] = pts0a[[All, 1]] - 50;
pts1a[[All, 2]] = pts0a[[All, 2]] + 80;
pts1a[[All, 3]] = pts0a[[All, 3]] + 200;

pts1b = pts0b;
pts1b[[All, 1]] = pts0b[[All, 1]] - 50;
pts1b[[All, 2]] = pts0b[[All, 2]] + 70;
pts1b[[All, 3]] = pts0b[[All, 3]] + 100;

pts1All = {pts1a, pts1b};

Plot settings

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

Scale functions needed to be modified later

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, \[Infinity]}]] &;

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

Now, I have some BubbleChart3D plots, but they are not what I ultimately want.

Trial 1

BubbleChart3D[addMetaData[pts1a, bsizes], ImageSize -> 200, 
  BoxRatios -> boxRatio1, PlotRange -> plotRange1, 
  ChartElementFunction -> cef2[boxRatio1, plotRange1]]

Trial 1 looks good (e.g. which keep the shape of data as spheres and use the data's 4th column as point sizes). But I want pts1All to be plotted in 2 colors, instead of just plotting pts1a.

enter image description here

Trial 2

BubbleChart3D[pts1All, ImageSize -> 200, BoxRatios -> boxRatio1, PlotRange -> plotRange1]

Trial 2 includes both sets of data points in 2 colors, but the shape is not spherical.

enter image description here

Trial 3

BubbleChart3D[addMetaData[pts1All, bsizes], ImageSize -> 200,
  BoxRatios -> boxRatio1, PlotRange -> plotRange1,
  ChartElementFunction -> cef2[boxRatio1, plotRange1]]

Trial 3 includes both sets of data points in 2 colors, but the size of points are not varying according to the data's 4th column.

enter image description here

What I want is a plot which fulfills all 3 conditions:-

  1. Keep the shape of data as spheres;
  2. Use the data's 4th column as point sizes;
  3. Includes both sets of data points (i.e. pts1All) in 2 colors

I trust I need to modify cef2 and addMetaData, but I don't know what to do. Any idea?

Thanks!

$\endgroup$
3
$\begingroup$

Modification of addMetaData that works for both single and multiple datasets:

ClearAll[addMetaData2]
addMetaData2[data_, bsizes_] := Module[{minmax = If[Length @ Dimensions @ data == 2, 
    MinMax[data[[All, -1]]],  MinMax[data[[All, All, -1]]]]},
   data -> {minmax, bsizes}];

BubbleChart3D[addMetaData2[pts1All, bsizes], ImageSize -> 200, 
 BoxRatios -> boxRatio1, PlotRange -> plotRange1, 
 ChartElementFunction -> cef2[boxRatio1, plotRange1]]

enter image description here

$\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.