How to show two or more non-overlapping label in a same position
Update: Using Kuba's nested Callout
approach is more robust than the jittering approach in my original answer.
The function processCallouts
below replaces repeated Callout
s with nested Callout
s with appropriate position parameters:
ClearAll[processCallouts]
processCallouts[ls_ : 20, ns_ : 20, off_ : 5, o: OptionsPattern[Callout]] := Flatten @
Replace[GatherBy[#, First], a : {_Callout, __Callout} :> Module[{args =
Thread[{a[[All,2]] , ArcTan @@@ N @ CirclePoints[Length @ a] }]},
Fold[Callout[#, #2[[1]], Automatic, LeaderSize -> {{ls, #2[[2]], off}, {ns}}, o]&,
a[[1,1]], args]] , ∞] &;
Examples:
call2 = Join[call, Callout[call[[4, 1]], #] & /@ CharacterRange["A", "D"]];
ListPlot[processCallouts[] @ call2, PlotRange -> {2010, 2050},
BaseStyle -> PointSize[Large], Frame -> True, ImageSize -> 500]
ListPlot[processCallouts[20, 20, 5,
CalloutMarker -> "CirclePoint", LabelStyle -> {16, Red}] @ call2,
PlotRange -> {2010, 2050}, BaseStyle -> PointSize[Large], Frame -> True]
call3 = Join[call, Callout[call[[4, 1]], #] & /@ CharacterRange["A", "Q"]];
ListPlot[processCallouts[60, 0, 0, CalloutMarker -> "CirclePoint",
LabelStyle -> Red] @call3, PlotRange -> {2010, 2050},
BaseStyle -> PointSize[Large], Frame -> True]
Surprisingly, this approach handle any practically relevant number of labels:
ListPlot[processCallouts[230, 0, 20][Callout[{50, 50}, #, LabelStyle->Tiny]&/@Range[99]],
AspectRatio -> 1, Axes -> False, PlotRangePadding -> Scaled[.02], ImageSize -> 600]
Original answer:
jitter[epsilon_:.001]:= MapAt[# + RandomReal[{-epsilon, epsilon}, 2]&, #, {1}]&;
newcalls = Join @@ Replace[GatherBy[call, First], a:{__Callout}:>(jitter[]/@a), ∞];
ListPlot[newcalls]
Another example:
call2 = Join[call, Callout[call[[4,1]],#]& /@ CharacterRange["A", "D"]];
newcalls2 = Join @@ Replace[GatherBy[call2, First], a:{__Callout}:>(jitter[.25]/@a), ∞];
ListPlot[newcalls2, PlotRange -> {2010, 2060}]
Random jittering does not always produce all labels. More regular jittering using CirclePoints
around the original point followed by post-processing to remove the added points may be the way to go.
Just nest Callouts
:
ListPlot[{16, Callout[Callout[20, "right", Right], "left", Left], 35, 39}]