# How can I mark each of several plots with a parameter that identifies it?

I've got a two variable function that I'm plotting against one axis for a few different values of a parameter

Clear[f, r]
f[r_] := 4 r /(1 - r)^2
i[r_, delta_] := 1/(1 + f[r] Sin[delta/2]^2)
Show[
Table[ Plot[i[r, delta], {delta, 0, 4 Pi},
PlotRange -> {0, 1}], {r, {0.1, 0.3, 0.6, 0.97}}]
]


This looks like but I'd like to label each of the curves with the value of the parameter (r = 0.1, r = 0.3, ...). I can do this manually inserting labels with the Graphics controls, but figured there's got to be a better way.

• It would certainly be nice if there were some way to use Tooltip for this sort of thing. – murray Nov 5 '12 at 23:16
• Looks like there's a ToolTip like LabelingFunction for Charts, but I don't see a way to use those with Plot – Peeter Joot Nov 6 '12 at 14:32

I'd invert Table and Plot :

Needs["PlotLegends"]

Plot[Evaluate@Table[i[r, delta], {r, {0.1, 0.3, 0.6, 0.97}}], {delta, 0, 4 Pi},
PlotRange -> {0, 1}, PlotLegend -> {0.1, 0.3, 0.6, 0.97}, LegendPosition -> {0.95, 0.05}] • Can you explain what you are doing with Evaluate@ here? – Peeter Joot Oct 30 '12 at 21:44
• @Peeter, Evaluate[] forces the first argument of Plot[] to be an explicit list of functions, which are then plotted with different colors. Execute Plot[Table[x^k, {k, 0, 2}], {x, 0, 1}] and Plot[Evaluate @ Table[x^k, {k, 0, 2}], {x, 0, 1}] to see the difference. – J. M. will be back soon Oct 30 '12 at 22:41
• @PeeterJoot Without the Evaluate Plot only sees one function and thus will not get the coloring and the legend right. Just try and look at the result. Just as an aside, there is also an undocumented option Evaluated->True which does the same thing, but is preferable as it also results in correct scoping. – sebhofer Oct 30 '12 at 22:41
• Thanks. I didn't realize there's a Hold attribute associated with Plot, and found an explaination of that here: mathematica.stackexchange.com/questions/6894/… – Peeter Joot Oct 31 '12 at 1:06
• Instead of PlotLegends, consider using the code in this excellent answer: mathematica.stackexchange.com/a/4028/745. It gives much much nicer legends. – Ajasja Oct 31 '12 at 9:57

I made a function that could be used for labeling plots interactively, adding labeled Bezier arrows, preserve your labels from session to session, and a few more goodies.

Some snapshots follow:

Calling code:

Clear[f, r]
f[r_] := 4 r/(1 - r)^2
i[r_, delta_] := 1/(1 + f[r] Sin[delta/2]^2)
s = Plot[Evaluate@Table[i[r, d], {r, {.1, .3, .6, .97}}], {d, 0, 4 Pi}, PlotRange -> {0, 1}];
lblPlot[s, {FontFamily -> "xkcd", 16}]


Working area: Result Edit:

Per @Rojo's request, added an option to preload old exported lbls like this:

lblPlot[s, {FontFamily -> "xkcd", 16}, optLblsO -> oldExportedLabels]


As the code is too long for posting it here, you can download it by executing:

NotebookPut@ImportString[Uncompress@FromCharacterCode@Flatten@ImageData[
Import@"http://i.stack.imgur.com/3pcrS.png","Byte"],"NB"]


Edit

ClearAll[lblPlot];
Options[lblPlot] = {maxArrowedLbls -> 5, maxNonArrowedLbls -> 5, optLblsO -> {}};
lblPlot[s_Graphics, myStyle_List: {FontFamily -> "Times", 16}, OptionsPattern[]] :=

(* Thanks to @WReach, @jVincent and @chris @Rojo for their useful help and code *)
(* Errors, bugs and bad coding due to belisarius*)

Module[{myLabel, copyToNewNB, exportLbls, printLbls, u, plotRsrv,
safeGuard = {"FeboAsoma"}, optLbls},

myLabel[{str_, {p1_, p2_, p3_}}] := {Thick, Arrow@BezierCurve[{p3, p2, p1}],
Inset[Style[str, myStyle], p3, Background -> White]};

myLabel[{str_, p1 : {_, _}}] := {Thick, Inset[Style[str, myStyle], p1, Background -> White]};

copyToNewNB[plot_, list_] := Module[{nb},  nb = NotebookCreate[];
NotebookWrite[nb, Cell[BoxData@ToBoxes@plot, "Output"]];
printLbls[nb, list]; ];

exportLbls[list_] := Module[{nb},  nb = NotebookCreate[]; printLbls[nb, list];];

printLbls[nb_, list_] := (NotebookWrite[nb,
Cell["Reserve the following expression in your Notebook to \
restore your Labels and Arrows the next time you need to include them \
in the Plot", "Subsection", CellMargins -> {{50, 50}, Inherited}]];
NotebookWrite[nb, Cell[BoxData@ToBoxes@Join[safeGuard, list, safeGuard], "Output"]];);

u = Array[(PlotRange /. Options[s, PlotRange])[[All, 1]] +
Flatten[Differences /@ (PlotRange /. Options[s, PlotRange])/4] # &, 3];

optLbls = OptionValue[optLblsO];

Panel@DynamicModule[{pts1 = {}, pts2 = {}, lbl1 = {}, lbl2 = {}, varRsrv = "Label Import Area"},

If[Head[optLbls] == List && Length@optLbls == 6 &&
optLbls[] == optLbls[[-1]] == safeGuard[],
{pts1 = optLbls[], pts2 = optLbls[], lbl1 = optLbls[], lbl2 = optLbls[]}];

Column[{Dynamic@ Show[
plotRsrv = Show[s, Epilog -> myLabel /@ Join @@
{MapIndexed[{lbl1[[#2[]]], #1} &, Partition[pts1, 3]],
MapIndexed[{lbl2[[#2[]]], #1} &, pts2]}, ImageSize -> 500],
Graphics[{
Dynamic@MapIndexed[ With[{i = #2[]}, Locator[Dynamic[pts1[[i]]]]] &, pts1],
Dynamic@MapIndexed[ With[{i = #2[]}, Locator[Dynamic[pts2[[i]]]]] &, pts2]},
PlotRange -> {{0, 1}, {0, 1}}]],

InputField[Dynamic@varRsrv, FieldSize -> 55, FieldHint -> "Label Import Area"],

Row[{
If[Length@pts1 < 3 OptionValue[maxArrowedLbls],
AppendTo[lbl1, "Arrow"]; pts1 = pts1~Join~(u)]],
If[Length@pts2 <
OptionValue[maxNonArrowedLbls], (AppendTo[lbl2, "Label"];
AppendTo[pts2, u[]])]],
Button["Copy to new .nb", copyToNewNB[plotRsrv, {pts1, pts2, lbl1, lbl2}]],
Button["Export Labels", exportLbls[{pts1, pts2, lbl1, lbl2}]],
Button["Import Labels",
(*validate the labels set, then import *)
If[
Head[varRsrv] == List && Length@varRsrv == 6 &&
varRsrv[] == varRsrv[[-1]] == safeGuard[],
{pts1 = varRsrv[], pts2 = varRsrv[],
lbl1 = varRsrv[], lbl2 = varRsrv[]},
MessageDialog["You're trying to Import a label set not created by \"Export Labels\""],
MessageDialog[{Head[varRsrv], varRsrv[] == varRsrv[[-1]] == safeGuard}]]
;]}],

Dynamic@Grid[Transpose[{
(*arrows*)
InputField[Dynamic[lbl1[[#]]], String],
Button["Delete" <> ToString@#,
(lbl1 = Drop[lbl1, {#, #}];
pts1 = Drop[pts1, {3 # - 2, 3 #}])]}] & /@
Range@(Length@pts1/3), Max[Length@lbl1, Length@lbl2], ""],
(*non- arrows*)
InputField[Dynamic[lbl2[[#]]], String],
Button["Delete" <> ToString@#,
(lbl2 = Drop[lbl2, {#, #}];
pts2 = Drop[pts2, {#}])]}] & /@ Range@(Length@pts2),
Max[Length@lbl1, Length@lbl2], ""]
}], ItemSize -> 30]}]]
]

Clear[f, r]
f[r_] := 4 r/(1 - r)^2
i[r_, delta_] := 1/(1 + f[r] Sin[delta/2]^2)
s = Plot[Evaluate@
Table[i[r, delta], {r, {0.1, 0.3, 0.6, 0.97}}], {delta, 0, 4 Pi},  PlotRange -> {0, 1}];
lblPlot[s, {FontFamily -> "xkcd", 16}]


You can also use Epilog to place the labels on the lines.

Example:

Row[Plot[Evaluate@
Table[i[r, delta], {r, {0.1, 0.3, 0.6, 0.97}}], {delta, 0, 4 Pi},
PlotRange -> {Automatic, {0, 1}},
PlotStyle -> (Directive[Thick, #] & /@ {Red, Green, Blue, Orange}),
PlotRangePadding -> .05, Frame -> True, ImageSize -> 400,
Epilog -> {Table[(Style[Text[r, {#, i[r, #]}], 12,
Background -> White] &) /@ (#),
{r, {0.1, 0.3, 0.6, 0.97}}]}] & /@
{{Pi}, {3 Pi}, {Pi/2, 3 Pi/2, 5 Pi/2, 7 Pi/2}}, Spacer] • Excellent. That's much more like what I was thinking. If I try modifying the text to Text[ "R = " r, ... then strangely it displays as "0.1 R =", "0.3 R =", ... ? Is there a way to concatonate multiple text objects at the location specified by one? – Peeter Joot Oct 31 '12 at 13:14
• @Peeter, try Text[Row[{"R = ", r}], {#, i[r, #]}]. – kglr Oct 31 '12 at 15:19
• .. or Text["r = " <> ToString[r], {#, i[r, #]}]. – kglr Oct 31 '12 at 15:32
• StringForm[] would also be convenient to use here... – J. M. will be back soon Nov 7 '12 at 5:23

Using PlotLabels makes it straightforward:

f[r_] := 4 r/(1 - r)^2
i[r_, delta_] := 1/(1 + f[r] Sin[delta/2]^2)
place = {Scaled[r], After};
Show[Table[
Plot[i[r, delta], {delta, 0, 4 Pi}, PlotRange -> {0, 1},
Frame -> True,
PlotLabels -> Placed[{ToString[r]}, place]], {r, {0.1,
0.3, 0.6, 0.97}}]] One can use different placements, i.e. different location specifications instead of place; I chose Scaled[r] because for this particular plot it works fine and After` because in my opinion it looks best.

• My question was old (Mathematica 8 days). This new better labelling option was mentioned in a comment referring to: mathematica.stackexchange.com/questions/4025/… Also note that Mathematica11 appears to have further refined its Labelling methods, but I haven't purchased the upgrade to try that out. – Peeter Joot Sep 1 '16 at 21:51
• I get it all, I just stumbled upon this question acidentally, so to speak, and thought it might be useful for future users to point them toward some update. – corey979 Sep 1 '16 at 22:12