Labeling individual curves in Mathematica

Question

I need to create a plot for export and inclusion in a report. Is there a better way to label curves than PlotLegends? From what I've read and my personal experience, PlotLegends is pretty bad.

Is there a better package for legends, or, ideally, a simple way to place small text next to each curve?

Answer 1

You can make use of the following options in Plot, e.g. :

Plot[ Tooltip @ {x^2, x^3, x^4}, {x, -2, 2}, 
      PlotStyle -> {Red, Green, Blue}, 
      PlotRangePadding -> 1.1] /. {Tooltip[{_, color_, line_}, tip_] :>   
                                   {Text[Style[tip, 14], {.1, 0} + line[[1, -1]]], color, line}}

Update (05.02.2016)

Tried the above code in Mathematica 10.3.1 and it did not work. This code works:

Plot[Tooltip@{x^2, x^3, x^4}, {x, -2, 2}, 
  PlotStyle -> {Red, Green, Blue}, 
  PlotRangePadding -> 
   1.1] /. {Tooltip[{___, dir_Directive, line_Line, ___}, 
    tip_] :> {Text[Style[tip, 14], {.1, 0} + line[[1, -1]]], dir, 
    line}}

Edit

Since there was another question in the comments I add another way of labeling curves. If we have to plot a graph of a family of certain functions, and insert its definition i.e.

we can make use of Drawing Tools in the Front End (a shortcut Ctrl-D) to insert some text supplemented by appropriate arrows pointing only a few of all functions.
We paste a simple text i.e. output of Text[Style["n = 13", Large, Bold, Blue]] or the definition of the functions, by double-clicking the right button of the mouse, next once the left one and selecting from menu Paste into Graphic to insert a data from the clipboard. Similarly we choose arrows from the section Tools of Drawing Tools and adjust them by dragging apprporiately. Alternatively to pasting the definition of functions with Drawing Tools, we can make use of also PlotLabel option of Plot to insert it, i.e. PlotLabel -> Subscript[f, n][x] == (1 - x^2/6 + x^4/120)^n

Plot[ Evaluate[(1 - x^2/6 + x^4/120)^n /. n -> Range[1, 30, 3]], {x, 0, Sqrt[6] },
      AspectRatio -> Automatic, AxesOrigin -> {0, 0}, PlotStyle -> Thick ]

Answer 2

Here is an interactive version, with definition below.

A functional plot,

functionplot=Plot[{Sin[x],Cos[x]},{x,0,2\[Pi]},
      Frame->{True,True,False,False},
      FrameLabel->{"x","y(x)"},
      FrameStyle->Directive[13,Italic],
      PlotStyle->Thick,
      PlotRangeClipping->False,
      PlotRange->{-1.2,1.2},
      AxesStyle->Dashed];

To label this plot with specified labels for each curve (Sin, Cos), run the following to get automatically updating labels based on mouse pointer proximity to each curve; click with the mouse to stick labels wherever you wish:

dynamicLabeled[functionplot,{{Sin,"Sine"},{Cos,"Cosine"}}]

(The above image does not do justice to the Dynamic interactivity.)

It works with ListPlot too:

data1=Table[{x,.5Exp[-1/2 ((x-5)/1)^2]+RandomReal[NormalDistribution[0,.05]]},{x,0,10,.25}];
data2=Table[{x,-Sin[x]+RandomReal[NormalDistribution[0,.08]]},{x,2,8,.1}];
dataplot=ListPlot[{data1,data2},
       PlotStyle->{Thick,PointSize[0.015]},
       PlotRange->{-1.2,1.45},
       Joined->{True,False}];

dynamicLabeled[dataplot,{{data1,"Exponential"},{data2,"Sinusoidal"}}]

The current state of the plot for the dynamicPlot most recently clicked can be stored in a global variable for later processing or export. In the code below this is set to currentPlot.

Some parts are hard-coded (arrow styling and label styling)---you can tune those to suit, or extend the flexibility. It does not handle mixed functional-data plots, but that is easy to circumvent by turning the data into an InterpolatingFunction, or displaying the function as a Table of points. Have fun.

Here is the definition of dynamicLabeled:

Clear[dynamicLabeled];
dynamicLabeled[plot_,labelling_] := DynamicModule[
  {p,x,x1,x2,storedlabels={},currentlabel,aspect,distances,xs,rs,res,ind,ps,ps1,curves,labels,pt},
  curves=labelling[[All,1]];
  labels=labelling[[All,2]];
  aspect=Options[plot,AspectRatio][[1,2]];
  Dynamic[
    p=MousePosition["Graphics"];
    If[p=!=None,
      pt={p[[1]],p[[2]]/aspect};
      Switch[curves,
        _?(VectorQ[#,AtomQ]&),
          (* list of functions *)
          rs=Quiet@FindMinimum[Norm[pt-{x,#[x]/aspect}],{x,p[[1]]}]&/@curves;
          res={#[[1]],#[[2,1,2]]}&/@rs;
          distances=res[[All,1]];
          xs=res[[All,2]];
          ps=Quiet@MapThread[{#1,#2[#1]}&,{xs,curves}];,
        _,
          (* functions is a list of data *)
          ps1=Flatten[Nearest[#,pt,1]]&/@(curves/.{x_?NumericQ,y_?NumericQ}:>{x,y/aspect});
          distances=Norm[#-pt]&/@ps1;
          ps=ps1/.{x_?NumericQ,y_?NumericQ}:>{x,y*aspect};          
      ];
      ind=Flatten[Position[distances,Min[distances]]][[1]];
    ];
    MouseAppearance[
      EventHandler[
        currentPlot = Show[plot,
          Epilog->{
            storedlabels,
            If[p=!=None,
              currentlabel={
                Text[Style[labels[[ind]],13],p,{0,Sign[ps[[ind]][[2]]-p[[2]]]}],
                Arrow[{p,ps[[ind]]}]
              }
            ]
          }
        ],
        {{"MouseClicked",1}:>(AppendTo[storedlabels,currentlabel])}
      ],
      Graphics[{PointSize[0],Point[{0,0}]}]
    ]
  ]
]

Answer 3

Mathematica 11 comes with "New Labeling System", make such things much easier!

As an illustration, the first example in Artes's answer can be as simple as

Plot[{x^2, x^3, x^4}, {x, -2, 2}, PlotLabels -> Automatic, PlotRange -> All]

Much more to be discovered such as Callout on Visualization: Labels, Scales, Exclusions

Answer 4

I use a homebrew solution, called as follows:

Show[Plot[{x, x^2}, {x, 0, 1}, PlotStyle -> {Red, Blue}], 
 tCustomLegend[{tCustomLegendItem[Line, x, PlotStyle -> Red], 
   tCustomLegendItem[Line, x^2, PlotStyle -> Blue]}, {0.2, 0.8}]]

Giving

The full code is:

tYellow=RGBColor[1,0.8,0.2];

tColorList=ColorData[3,"ColorList"];
tColorList[[3]]=tYellow;
tColorList[[4]]=RGBColor[0,0.6,0];
tColorList = tColorList[[{6,2,4,7,5,10,8,9,3,1}]];

tCustomLegendItem::usage="tCustomLegendItem[type,text,options]";
tCustomLegend::usage="tCustomLegend[list,loc,options]";

Begin["`Private`"];
Unprotect[tCustomLegendItem];
Clear[tCustomLegendItem];

Options[tCustomLegendItem]={
    Rule[PlotStyle,{tColorList[[1]]}],
    Rule[LegendLabelStyle,{FontSize->20}]
};

SyntaxInformation[tCustomLegendItem]={"ArgumentsPattern"->{_,_,OptionsPattern[]}};

tCustomLegendItem[type_,text_,options:OptionsPattern[]]:=Module[{object,styles,gfxOpts}, 

    Switch[type,
        Line,
            object=Line[{{0,0},{4,0}}];
            gfxOpts={ImageSize->40,AspectRatio->1/4},
        Point,
            object=Disk[];
            gfxOpts={ImageSize->{40,10}},
        Square,
            object=Rectangle[{0,0}];
            gfxOpts={ImageSize->{40,10}},
        FullSquare,
            object=Rectangle[{0,0}];
            gfxOpts={ImageSize->30}
    ];

    If[Head[OptionValue[PlotStyle]]===List,
        styles=Sequence@@OptionValue[PlotStyle],
        styles=OptionValue[PlotStyle]
    ];

    {   
        Graphics[{styles,object},gfxOpts],
        Graphics[{Text[Style[text,OptionValue[LegendLabelStyle]]]},ImageSize->{Automatic,{30}}]
    }
]

Protect[tCustomLegendItem];

Unprotect[tCustomLegend];
Clear[tCustomLegend];

Options[tCustomLegend]=Join[
    Options[GraphicsGrid],
    Options[tCustomLegendItem]
];

SyntaxInformation[tCustomLegend]={"ArgumentsPattern"->{_,{_,_},OptionsPattern[]}};

tCustomLegend[list_,loc_,options:OptionsPattern[]]:=( 
    Graphics@Inset[
        GraphicsGrid[list,
            Sequence@@Evaluate@FilterRules[{options},{Options[GraphicsGrid]}],
            Alignment->{{{Center,Left}}},
            Spacings->{10,0},
            PlotRangePadding->5
        ], (* End of GraphicsGrid *)
        loc
    ] (* End of Graphics@Inset *)
)

Protect[tCustomLegend];

End[];

Answer 5

The SciDraw package (LevelScheme successor) has support for labelling curves. Here's an example:

Needs["SciDraw`"]

Figure[
 FigurePanel[
  {
   FigLine[Plot[Sin[x], {x, 0, 10}], 
    LineColor -> Apricot,
    CenterLabel -> "sine", CenterLabelPosition -> 0.55, 
    TextOffset -> Top];

   FigLine[Plot[Cos[x], {x, 0, 10}],
    LineColor -> OliveDrab,
    CenterLabel -> "cosine", CenterLabelPosition -> 0.6, 
    TextOffset -> Bottom
    ];
  },
  XPlotRange -> {0, 10}, YPlotRange -> 1.2 {-1, 1},
  Style -> {FigLine -> {LineThickness -> 2}}
 ]
]

It also has support for positioning styled labels with anchor points.

Answer 6

Here's another solution providing interactive labeling functionality similar to JxB's answer. That is, you can hover over the curves to see their label as a Tooltip, but then click at any point on the curve to make the label stick permanently to that position:

Options[burnTooltips] = {ImageSize -> 360, 
   "LabelFunction" -> (Framed[#, FrameStyle -> None, 
       RoundingRadius -> 8, Background -> RGBColor[1, .8, .4]] &)};

burnTooltips[plot_, opt : OptionsPattern[]] := 
 DynamicModule[{ins = {}, wrapper = OptionValue["LabelFunction"], 
   toolRule = 
    Function[{arg}, 
     Tooltip[t__] :> 
      Button[Tooltip[t], 
       AppendTo[arg, 
        Inset[wrapper[Last[{t}]], MousePosition["Graphics"]]]], 
     HoldAll]}, 
  EventHandler[
   Dynamic@Show[plot /. toolRule[ins], Graphics@ins, 
     ImageSize -> OptionValue[ImageSize]], {"MouseUp", 
     2} :> (toolRule = {} &)]]

p = Plot[Evaluate[Table[Tooltip[4 x/l + 2, l], {l, 10, 40, 10}]], {x, 
    0, 100}, ImageSize -> 500, 
   PlotLabel -> Style["y vs x"]];

burnTooltips[p]

The picture shows a plot p in which Tooltip was used to provide labels when you hover over the lines (see the 10 with the yellow background, the mouse there too but isn't captured in the screen shot). The orange labels on the lower curves have been created by simply clicking at those spots.

The labels can be styled with the option "LabelFunction" as shown near the top of the code. it's a function accepting the Tooltip content as its argument, and outputting (by default) a Framed object. To make them partly transparent, e.g., one could give this option:

"LabelFunction" -> (Framed[#, FrameStyle -> None, RoundingRadius -> 0,
 Background -> RGBColor[1, .8, .4, .5]] &)

Answer 7

I'll admit, I cheated. I use an energy level scheme, via LevelScheme`, to create a my legends. It is entirely manual, but they're not bad.

Here's one such legend

which was produced with this code snippet

Figure[{

   (* the rest of the figures code went here *)

   ScaledFigurePanel[
    {{0.03, 0.55}, {0.37, 0.77}},
    PlotRange -> {{0, 10}, {0, 10}},
    FrameTicks -> None,
    Frame -> False
   ],

   (* The legend is set up as a bunch of levels *)
   SetOptions[ Lev, Thickness -> 1],
   SetOptions[ LevelLabel, FontSize -> 0.9*tickFraction*defFontSize, 
     Gap -> 4],

   Lev[ es, 0, 2, 8], LevelLabel[es, Right, "Excited State"],
   SchemeSquare[{1, 8}, Point[5], FillColor -> Darker[Blue], 
     Color -> Darker[Blue], Layer -> 3],

   Lev[ gs, 0, 2, 5], LevelLabel[gs, Right, "Ground State"],
   SchemeCircle[{1, 5}, Point[5], FillColor -> Darker[Red], 
     Color -> Darker[Red], Layer -> 3 ],

   Lev[ pc, 0, 2, 2], LevelLabel[pc, Right, "Partially Converged"],
   SchemeCircle[{0.5, 2}, Point[5], ShowFill -> False, 
     Color -> Darker[Red], Layer -> 3],
   SchemeSquare[{1.5, 2}, Point[5],  ShowFill -> False, 
     Color -> Darker[Blue], Layer -> 3]
 },
 PlotRange -> {{-0.1, 1.01}, {-0.1, 1.01}},
 ImageSize -> {840, 680}
]

First of all, a LevelScheme graphic operates just like a normal graphic in that it is comprised of a stateful list, i.e. a primitive is only affected by the nearest preceding directive. For instance,

Graphics[{Red, Circle[], Blue, Rectangle[]}] 

produces a red circle overlain by a blue rectangle. So, in the above legend, the level scheme will be placed on a ScaledFigurePanel which overlays the other plots within the Figure (not shown). From there I set styling options on both the "energy level" Lev and its label. Each level is then constructed via

Lev[ aName, x1, x2, y ]

and LevelLabel finds it using aName. From there, it is just working on the placement of the plot symbols until they look right.

Answer 8

The Mathematica 9 PlotLegends -> Placed is nicer than the old PlotLegends package. Here's an example:

Plot[{BesselK[2, z], BesselK[2, 1/z]}, {z, 0.3, 3},
 AxesLabel -> {z},

 PlotLegends ->
  Placed[{TraditionalForm[BesselK[2, z]],
    TraditionalForm[BesselK[2, 1/z]]}, {Right, Bottom}]
 ]

Under Placed, the option that are available are: {Below,Above,Before,After, Right,Left,Center}

Answer 9

Try the new wrapper function Callout; it worked amazingly well for me with DateListPlot to make an online, continuously updating strip chart. The legends actually moved with the data as the chart data was changed.