10
$\begingroup$

I have such callout

call = {Callout[{756., 2047.5}, 1], Callout[{821.21, 2041.23}, 2], 
   Callout[{1057.63, 2030.22}, 4], Callout[{1057.63, 2030.22}, 6], 
   Callout[{1327.12, 2044.06}, 7]};

Note I cannot show two different labels in one position

ListPlot[call]

Actually, the following plot is expected

$\endgroup$
  • $\begingroup$ newcalls=Join@@Replace[GatherBy[call, First], {Callout[a__],Callout[b__]}:>{Callout[a, Before],Callout[b,After, LeaderSize->{30,45,5}]}, Infinity]; ListPlot[newcalls]? $\endgroup$ – kglr May 28 '18 at 7:20
  • $\begingroup$ @kglr Thanks. :) $\endgroup$ – yode May 28 '18 at 7:28
  • $\begingroup$ .. or newcalls=Join@@Replace[GatherBy[call, First], {Callout[a_,b___],Callout[c_,d___]}:>{Callout[a+RandomReal[{-.001,.001}], b],Callout[c+RandomReal[{-.001,.001}], d]}, Infinity]; ListPlot[newcalls]? $\endgroup$ – kglr May 28 '18 at 7:35
  • $\begingroup$ Why store such a small dataset in an image? The question would be clearer with the actual data for call in it, don't you think? It's quite small and easy to read, and I don't have to wonder what's going on when reading the question. (That's especially true if M is inaccessible when reading.) $\endgroup$ – Michael E2 Jun 1 '18 at 14:47
  • $\begingroup$ @MichaelE2 Hi, I think it is not a big problem. But I have fixed it by your advice. Thanks anyway. :) $\endgroup$ – yode Jun 1 '18 at 17:39
14
$\begingroup$

Update: Using Kuba's nested Callout approach is more robust than the jittering approach in my original answer.

The function processCallouts below replaces repeated Callouts with nested Callouts 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]

enter image description here

ListPlot[processCallouts[20, 20, 5,
    CalloutMarker -> "CirclePoint", LabelStyle -> {16, Red}] @ call2,
  PlotRange -> {2010, 2050},  BaseStyle -> PointSize[Large], Frame -> True]

enter image description here

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] 

enter image description here

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]

enter image description here

Original answer:

jitter[epsilon_:.001]:= MapAt[# + RandomReal[{-epsilon, epsilon}, 2]&, #, {1}]&;
newcalls = Join @@ Replace[GatherBy[call, First], a:{__Callout}:>(jitter[]/@a), ∞];
ListPlot[newcalls]

enter image description here

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

enter image description here

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.

| improve this answer | |
$\endgroup$
  • $\begingroup$ There may be a typo. I needed to add an Automatic to LeaderSize to reproduce your result: LeaderSize -> {{ls, #2[[2]], off}, {ns, Automatic}}. (V11.2, MacOS) $\endgroup$ – Michael E2 Jun 1 '18 at 15:07
  • $\begingroup$ @MichaelE2, it is probably depends on version/OS. It works as is in version 11.3 on Wolfram Cloud. $\endgroup$ – kglr Jun 1 '18 at 15:14
9
$\begingroup$

Just nest Callouts:

ListPlot[{16, Callout[Callout[20, "right", Right], "left", Left], 35,  39}]

enter image description here

| improve this answer | |
$\endgroup$
  • $\begingroup$ Thanks,trick, but it I want to label it with 5 or more different labels? $\endgroup$ – yode May 28 '18 at 7:26
  • 1
    $\begingroup$ @yode I see kglr already answered. Next time make your question clear from the start. p.s. maybe edit it as it still says about two labels. $\endgroup$ – Kuba May 28 '18 at 8:09
  • 1
    $\begingroup$ Note my question title have emphasized "two or more"... $\endgroup$ – yode May 29 '18 at 1:46
  • 1
    $\begingroup$ @yode fair enough, why didn't you repeat it in the body then :p $\endgroup$ – Kuba May 29 '18 at 7:08

Not the answer you're looking for? Browse other questions tagged or ask your own question.