9
$\begingroup$

How to make callouts in a bubble chart in the same style as below? Specifically, I'd like to know how to make the callout stems match their target bubble colors (automatically).

enter image description here

What I've tried:

n=6;
lbls=ResourceFunction["RandomString"][{n, 10}];
BubbleChart[Callout@RandomReal[1,{n,1,3}],
     ChartLabels->Callout[lbls,LeaderSize->{Automatic,90\[Degree],Automatic},CalloutStyle->Automatic]]

An ideal solution would make recreate the stem's shape too (90 degrees with the little dot) and work for other charts/plot types, e.g. BubbleChart3D, BarChart, etc, e.g.

BarChart[<|"a"->1,"b"->2,"c"->5,"d"->3|>,
     ChartLabels->Callout[Automatic,Above,CalloutStyle->66],ChartStyle->66]
BubbleChart3D[RandomReal[1,{n,1,4}],ChartLabels->Callout[lbls]]

Notes:

$\endgroup$

3 Answers 3

9
+25
$\begingroup$
n = 20;
SeedRandom[77];

lbls = ResourceFunction["RandomString"][{n, 10}];
data = RandomReal[1, {n, 3}];

BubbleChart

Use Callout as wrapper on input data:

bubblechart = BubbleChart[MapThread[
      Callout[Style[#, Directive[EdgeForm[]]], #2, Automatic, 
        Appearance -> "Leader", 
        LabelVisibility -> All,
        CalloutMarker -> 
           Arrowheads[{{0, 1}, {Automatic, 0,          
             Graphics[{ Opacity[.5], Disk[Offset[{-5, 0}, {0, 0}], Offset[5]]}]}}], 
        CalloutStyle ->
           {Directive[Thick, CapForm["Butt"], Opacity[.5], #3], Opacity[0]}] &, 
    {data, Style[#, FontSize -> 14] & /@ lbls, ColorData[66] /@ Range[n]}], 
  PerformanceGoal -> "Speed", 
  ChartStyle -> 66, 
  ChartBaseStyle -> Opacity[.5],
  ImageSize -> 600] 

enter image description here

 postProcess = ReplaceAll[ {_Polygon -> {}, 
    Arrow[a_, ___] :> Arrow[a, {0, -.0075}], 
    Text[a_, Offset[o_, b_], c_] :> 
       Text[a /. Rule[FontSize, _] :> Rule[FontSize, Scaled[.025]], 
        Offset[o/3, b], (-Sign@o) /. {0, y : Except[0]} :> y {-1.2, 0.5}]}];

 postProcess @ bubblechart 

enter image description here

Show[postProcess @ bubblechart /. 
   {Offset[5] -> Offset[3], Offset[{-5, 0}, p_] -> Offset[{-3, 0}, p]}, 
  ImageSize -> 400]

enter image description here

Notes: It is important (1) to use a large font size in printer points rather than in scaled size, and (2) to use a large image size in the original chart. Try using FontSize -> Scaled[.02] (instead of FontSize -> 14) and ImageSize -> 300 (instead of ImageSize -> 500) in the code above to see the reason.

BarChart

data2 = data[[;; 10, 1]];
lbls2 = lbls[[;; 10]];

barchart = BarChart[
  MapThread[
    Callout[Style[#, Directive[EdgeForm[]]], #2, Automatic, 
        Appearance -> "Leader", 
        CalloutMarker -> 
           Arrowheads[{{Automatic, 0,                      
             Graphics[{Opacity[.5], Disk[Offset[{-5, 0}, {0, 0}], Offset[5]]}]}}], 
        LeaderSize -> {{Automatic, 90 Degree, 0}, {10, 0 Degree}}, 
        CalloutStyle -> 
           Directive[Thick, CapForm["Butt"], Opacity[.5], #3]] &, 
    {data2, Style[#, FontSize -> Scaled[.02]] & /@ lbls2, ColorData[66] /@ Range[10]}],
  ChartStyle -> 66, 
  ChartBaseStyle -> Opacity[.5],
  ImageSize -> 800, 
  BarSpacing -> - .1]

enter image description here

Show[ReplaceAll[{_Polygon -> {},
     Text[a_, Offset[o_, b_], c_] :> 
        Text[a, Offset[o/4, b], {-Sign[o[[1]]], 0}]}] @ barchart, 
    ImageSize -> 800, ImagePadding -> {{5, 50}, {5, 5}}] 

enter image description here

Show[ReplaceAll[{_Polygon -> {},
      Text[a_, Offset[o_, b_], c_] :> 
       Text[a, Offset[{7, 10}, b], {-1, 1}, {0, 1}]}] @ barchart, 
     ImageSize -> 800, ImagePadding -> {{5, 5}, {5, 90}}]  

enter image description here

BarChart[MapThread[
   Callout[Style[#, Directive[EdgeForm[]]], #2, Automatic, 
      CalloutMarker -> 
          Arrowheads[{{Automatic, 0, 
            Graphics[{Opacity[.5], Disk[Offset[{-5, 0}, {0, 0}], Offset[5]]}]}}], 
      CalloutStyle -> Directive[Thick, CapForm["Butt"], Opacity[.5], #3]] &, 
   {data2, Style[#, FontSize -> Scaled[.02]] & /@ lbls2, ColorData[66] /@ Range[10]}],
   ChartStyle -> 66, 
   ChartBaseStyle -> Opacity[.5],
   ImageSize -> 700, 
   ImagePadding -> {{10, 10}, {10, 100}}, 
   BarSpacing -> - .2] /. 
 {_Polygon -> {} , 
  Text[a_, Offset[o_, b_], c_] :> Text[a, Offset[{0, 25}, b], {-1, 0}, {0, 1}]} 

enter image description here

$\endgroup$
3
$\begingroup$

For BarChart we can get the desired look using a custom ChartElementFunction since label positioning is much easier compared to BubbleChart:

ClearAll[CEF]
CEF[cedf_ : Automatic, o_ : 5] := 
  Module[{bb = 1.05 Charting`ChartStyleInformation["BoundingBox"][[2, 2]]},
  {Opacity[.5], Disk[Offset[{0, o}, {Mean@#[[1]], bb}], Offset[o]], 
   Text[Style[#3[[1]], FontOpacity -> 1, 14], Offset[{0, 3 o}, {Mean@#[[1]], bb}], 
      {-1, 0}, {0, 1}], 
   Thick, CapForm["Butt"], Line[{{Mean@#[[1]], #2}, {Mean@#[[1]], bb}}],
   (cedf /. Automatic -> ChartElementData["Rectangle"])[##]}] &

Examples:

n = 20;
SeedRandom[777];

lbls = ResourceFunction["RandomString"][{n, 10}];
data = RandomReal[1, n];  

Attach labels to data as metadata:

labelrules = Thread[data -> lbls];


BarChart[labelrules,  
  ChartStyle -> "Rainbow",
  ChartBaseStyle -> Directive[EdgeForm[], Opacity[.5]],
  ImageSize -> 600, 
  ImagePadding -> {{50, 10}, {20, 100}},
  BarSpacing -> {.1, 1},
  ChartElementFunction -> CEF[Automatic, 3]] 

enter image description here

An example with multiple datasets:

labelrules2 = Partition[labelrules, 4];
grouplabels = Style["group " <> ToString @ #, 16] & /@ Range[5];

BarChart[labelrules2,  
  ChartStyle -> "Rainbow",
  ChartBaseStyle -> Directive[EdgeForm[], Opacity[.5]],
  ImageSize -> 600, 
  ImagePadding -> {{50, 10}, {20, 100}},
  BarSpacing -> {.1, 1},
  ChartLabels -> {Placed[grouplabels, Axis], None},
  ChartElementFunction -> CEF[Automatic, 3]] 

enter image description here

$\endgroup$
3
$\begingroup$

Automatic placement of labels to avoid overlaps is a difficult task. Instead we can interactively position the labels using a custom ChartElementFunction.

The following ChartElementFunction allows control of label positions using Locators. The position of the label for a bubble is restricted to stay outside the bounding rectangle of the bubble. The label of a bubble is connected to the nearest of the four poles of the bubble. The first argument specifies the radius (in printer points) of the disk at the tip of the connector line. The second argument gives the style of the line and the third argument specifies the edge style of the main bubble and its connected disk.

A few requirements:

  1. We need to use BubbleChart with the option PerformanceGoal -> "Speed" and wrap BubbleChart with Deploy to get the Dynamic elements work properly.
  2. The labels should be attached to input data as metadata using the form {data1 ->label1, data2 -> label2 ...}.

ClearAll[labeledBubbleWithConnector]
labeledBubbleWithConnector[o_: 5, connectorstyle_: Thick, edgeform_: None] := 
 With[{bubble = First @ Cases[ChartElementData["Bubble"]@##, _Disk, All], 
    center = Mean /@ #, 
    box = TransformedRegion[Rectangle @@ Transpose @ #, 
      ScalingTransform[{1.25, 1.25}, Mean /@ #]], 
    color = Charting`ChartStyleInformation["Color"]}, 
   DynamicModule[{locator = center + 1.2 {bubble[[2, 1]], 0}, 
     label = #3[[1]], value = #2[[-1]], 
     anchors = center + # & /@ 
       Join[Thread[{{1, -1} bubble[[2, 1]], 0}], 
        Thread[{0, {1, -1} bubble[[2, 2]]}]]}, 
    {EdgeForm[edgeform /. Automatic -> Darker[color]], 
     Tooltip[bubble, value],
     Locator[Dynamic[locator, 
        (locator = If[RegionMember[box]@#, 
           RegionNearest[RegionBoundary@box]@#, #]) &], None], 
     Dynamic @ Module[{anchor1 = First @ Nearest[anchors, locator, 1], 
        middle, off = Sign[locator[[1]] - center[[1]]]}, 
       middle = Sequence @@ 
         If[Sign[anchor1[[2]] - center[[2]]] ==  0,
           {{(anchor1[[1]] + locator[[1]])/2, anchor1[[2]]}, 
            {(anchor1[[1]] + locator[[1]])/2, locator[[2]]}},
           {{anchor1[[1]], locator[[2]]}}]; 
       {FontOpacity -> 1, Text[label, Offset[2 o { off, 0}, locator], -{off, 0}], 
        Disk[locator, Offset[o]] ,
        CapForm["Butt"], connectorstyle, 
        Line[{anchor1, middle, Offset[-o {off, 0}, locator]}]}]}]] &

Examples:

dt = Thread[{{1, 1, 1}, {1, 1, 2}, {1, 1, 3}} ->
   (Style[#, 16, Black] & /@ {"aaplvhpmyk", "stuzprmmfp", "abgpfhxuop"})]; 

Deploy @ 
  BubbleChart[{dt}, 
   BubbleScale -> "Diameter", 
   PerformanceGoal -> "Speed", 
   PlotRangeClipping -> False, 
   PlotRange -> {{.5, 1.5}, {.5, 1.5}}, 
   ImageSize -> 600, 
   ImagePadding -> {{83, 83}, {20, 20}}, 
   ChartBaseStyle -> Directive[EdgeForm[], Opacity[.5]], 
   ChartStyle -> {None, "Rainbow"}, 
   ChartElementFunction -> labeledBubbleWithConnector[3]]

enter image description here

n = 20;
SeedRandom[77];

lbls = ResourceFunction["RandomString"][{n, 10}];
data = RandomReal[1, {n, 3}];

BubbleChart[{Thread[data -> (Style[#, 14, Black] & /@ lbls)]}, 
 BubbleScale -> "Diameter", 
 PerformanceGoal -> "Speed", 
 PlotRangeClipping -> False, 
 ImageSize -> 700, 
 ImagePadding -> {{83, 83}, {20, 20}}, 
 ChartBaseStyle -> Directive[EdgeForm[], Opacity[.75]], 
 ChartStyle -> {None, "Rainbow"}, 
 ChartElementFunction -> labeledBubbleWithConnector[3], 
 DisplayFunction -> Deploy]

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.