4
$\begingroup$

Would it be possible to put labels like this for all curves from 1 to 19?
It would also be nice if there are some way to put/adjust the position of labels manually for better positions.

myfunctions = {Abs[1 - 2 x], 3 - Abs[x], 1 - Abs[x]/3, 1 + x^2, 
   x^3 - 1, 5 - 2 Abs[x]/3, 1 + x, 1 - 2 x/3, 5 - x, 2 x - 5, 8 x - 5,
    1 - x - x^2, 2 - x/5, 5 - x, 3 - x^2, 6 - x^5/5, 2 + 3 x, 5 - E^x,
    ConditionalExpression[2, -3 <= x <= 1]};
Plot[myfunctions, {x, -5, 5}, PlotRange -> {Automatic, {0, 5}}, 
 GridLines -> Automatic, Frame -> True

enter image description here

I tried PlotLabels -> Range[19] but the labels'positions are not good and hard to read.

Plot[myfunctions, {x, -5, 5}, PlotRange -> {Automatic, {0, 5}}, 
 GridLines -> Automatic, Frame -> True, PlotLabels -> Range[19]]

enter image description here

$\endgroup$
1

3 Answers 3

7
$\begingroup$

enter image description here

An alternative approach: To avoid adding additional clutter with callout lines to an already crowded plot, we can place labels on the curves and interactively adjust the label positions using LocatorPane:

First construct a plot with Tooltips:

plot = Plot[Evaluate[MapIndexed[Tooltip[#, First@#2] &, myfunctions]], {x, -5,  5}, 
  ImageSize -> Large, PlotRange -> {Automatic, {0, 5}}, 
  GridLines -> Automatic, Frame -> True]

enter image description here

lines = Cases[plot, {_Directive, l__Line} :> RegionUnion[l], All];
n = Length @ lines;
pos0 = RandomPoint /@ lines;
rNFs = RegionNearest /@ lines;

DynamicModule[{pts = pos0}, 
 LocatorPane[
  Dynamic[pts, (Do[pts[[i]] = rNFs[[i]] @ #[[i]], {i, 1, n}])&],
  Dynamic[Show[plot, 
    plot /. Tooltip[{d___, __Line}, tip_] :> Tooltip[{d, Disk[pts[[tip]], Offset[10]], 
     {White, Disk[pts[[tip]], Offset[8]]}, Text[Style[tip, 12], pts[[tip]]]}, tip]]], 
  Appearance -> None]]

enter image description here

After interactive adjustments we get the picture above.

Note: I sure hope you are not dealing with this kind of plots too often:)

$\endgroup$
7
  • $\begingroup$ That's very nice. Would it be possible to limit the movement of each label on the its responding curve only? The problem is that sometimes I don't know which curve and which corresponding label it belongs to and move the wrong place. Also the curves also move when I select it which is undesied as well. $\endgroup$
    – hana
    Commented Mar 18, 2022 at 11:17
  • $\begingroup$ @hana,each label is already restricted to stay on the curve it belongs to (this is done by the second argument in Dynamic[pts, (Do[...])&)]). $\endgroup$
    – kglr
    Commented Mar 18, 2022 at 11:21
  • $\begingroup$ I'm sorry I probably checked the wrong code. It works perfectly. The only problem is somehow the curve and label's color doesn't match on my different example but I think I can solve it. $\endgroup$
    – hana
    Commented Mar 18, 2022 at 11:38
  • $\begingroup$ I wonder if you could help me test this example myfunctions = {ConditionalExpression[Abs[1 - 2 x], x >= 1 || x <= 0], ConditionalExpression[1 + x, x >= 0]}. The colors of curves and labels don't match. I think the problem is probably that the first function has two branches. Here is the image showing the problem. ibb.co/6XWK1PZ $\endgroup$
    – hana
    Commented Mar 18, 2022 at 18:51
  • 1
    $\begingroup$ @hana, you are right about the source of the problem. I will update with a fix. $\endgroup$
    – kglr
    Commented Mar 19, 2022 at 1:38
7
$\begingroup$

You may use Callout to explicitly set a location along the curve for the label.

Below I use Scaled to set the label at the start or end of the curve. Since the curves have varying start and end points this produces a spaced out labels.

With myfunctions in OP.

Plot[
 Evaluate[
  MapIndexed[
   Callout[#, First@#2, Scaled@Mod[First@#2, 2]] &
   , myfunctions
   ]
  ]
 , {x, -5, 5}
 , PlotRange -> {Automatic, {0, 5}}
 , GridLines -> Automatic
 , Frame -> True
 ]

Mathematica graphics

Evaluate is needed to evaluate MapIndexed before the expression is passed to Plot because Plot has Attributes HoldAll.

Hope this helps.

$\endgroup$
3
  • 1
    $\begingroup$ Thanks, I added CalloutMarker -> "Circle" to make it more clear to distinguish between lines. Would it be possible to change the some properties of these callouts such as color, bold to make it a bit more clear? Almost all callout looks good after adding CalloutMarker -> "Circle" but the numbers 10, 14, 19 are a bit confusing. $\endgroup$
    – hana
    Commented Mar 16, 2022 at 21:27
  • $\begingroup$ Try MapIndexed[Callout[#, Style[First@#2, 12, Bold, ColorData[97][First@#2]], Scaled@Mod[First@#2, 2], Appearance -> "Frame"] &, myfunctions] and PlotStyle -> ColorData[97]. $\endgroup$ Commented Mar 16, 2022 at 22:14
  • $\begingroup$ @RohitNamjoshi that doesn't really solve the problem I mentioned above. I probably should do it manually for each curve. $\endgroup$
    – hana
    Commented Mar 17, 2022 at 16:38
5
$\begingroup$
plot = Plot[Evaluate[MapIndexed[Tooltip[#, First@#2] &, myfunctions]], {x, -5,  5}, 
  ImageSize -> Large, PlotRange -> {Automatic, {0, 5}}, 
  GridLines -> Automatic, Frame -> True];

A simpler alternative to put labels on the curves:

Post-process plot to construct a label object (disks and a text label wrapped in GraphicsGroup) for each line. Then double-click the output to move the label objects to desired locations.

SeedRandom[1]
pos0 = RandomPoint /@ Cases[plot, _Line, All];

Show[plot, 
 plot /. Tooltip[{d___, _Line}, tip_] :> Tooltip[GraphicsGroup @ 
     {d, Disk[pos0[[tip]], Offset[10]], {White, Disk[pos0[[tip]], Offset[8]]}, 
      Text[Style[tip, 12], pos0[[tip]]]}, tip]]

enter image description here

Double-click on the output and drag the labels to desired locations:

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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