How to generate function name automatically in mathematica? - wolfram-mathematica

When I draw multiple functions like exp,2^x,3^x, is it possible to generate a label of each function?
My code now:
Plot[{Exp[x], 2^x, 3^x}, {x, -5, 2}, AspectRatio -> Automatic, PlotStyle -> {Red, Green, Blue}]
What I mean is generate 3 labels in this case to tell the user what function it is.
Such as:
How do you generate this?

Perhaps this works: Use Tooltip in Plot to generate a Graphics object with tooltips. Then rewrite the tooltip to place the desired text in the desired location:
Plot[
Tooltip#{Exp[x], 2^x, 3^x}, {x, -5, 2},
AspectRatio -> Automatic,
PlotStyle -> {Red, Green, Blue},
PlotRange -> All,
PlotRangePadding -> 1.1] /.
{
Tooltip[{_, color_, line_}, tip_]
:>
{Text[Style[tip, 14], {.25, 0} + line[[1, -1]]], color, line}
}

I am not sure what the rules are for adding another, different answer for the same question. But here is another, different way to do it. If I am supposed to add this to my first answer, I can do that.
You can add the text labels, by hand, using Text commands. I think it looks better. Here is one way:
Clear[x];
funs = {Exp[x], 2^x, 3^x};
funNames = Style[#, 12] & /# funs;
(*the x-axis plot range used *)
from = -5; to = 2;
(* generate the coordinates at the end of the plot lines*)
pos = Map[{to, #} &, funs /. x -> to];
(*generate the text labels *)
text = Map[Text[#[[1]], #[[2]], {-1, 0}] &, Thread[{funNames, pos}]];
Plot the final result (added a little of padding to plot range so that
the labels added are seen completely)
Plot[funs, {x, from, to},
PlotRangePadding -> {1, 1},
PlotStyle -> {Red, Green, Blue},
PlotRange -> All,
Epilog -> text
]
update (1)
Sam asked below for an simpler way. I am not sure now. But one way to make it easier to use this method, is to make a function and then simply call this function once to generate the Text labels. You can put this function where you put all your other functions you use all the time, and just call it.
Here is something: First write the function
(*version 1.1*)
myLegend[funs_List, (*list of functions to plot*)
x_, (*the independent variable*)
from_?(NumericQ[#] && Im[#] == 0 &),(*the x-axis starting plot range*)
to_?(NumericQ[#] && Im[#] == 0 &) (*the x-axis ending plot range*)
] := Module[{funNames, pos, text, labelOffset = -1.3},
(*make label names*)
funNames = Style[#, 12] & /# funs;
(*generated the coordinates at the end of the plot lines*)
pos = Map[{to, #} &, funs /. x -> to];
(*generate the Text calls*)
text = Map[Text[#[[1]], #[[2]], {labelOffset, 0}] &,
Thread[{funNames, pos}]]
];
And now just call the above any time you want to plot with labels. It will be just 1-2 extra lines of code. like this:
Clear[x]
from = -5; to = 2;
funs = {Exp[x], 2^x, 3^x};
Plot[funs, {x, from, to}, PlotRangePadding -> {1, 1},
PlotStyle -> {Red, Green, Blue}, PlotRange -> All,
Epilog -> myLegend[funs, x, from, to]]
Here are few examples:
You can modify it as you want.

Alternative way with Tooltip displaying labels while the mouse pointer is at the function graphs :
Plot[Tooltip#{Exp[x], 2^x, 3^x}, {x, -5, 2}, AspectRatio -> Automatic,
PlotStyle -> {Red, Green, Blue}]

One way is to use PlotLegends
(I do not like it too much, but it is an easy way to do what you want)
<< PlotLegends`
Clear[x];
funs = {Exp[x], 2^x, 3^x};
legends = Map[Text#Style[#, "TR", 12] &, funs];
Plot[Evaluate#funs, {x, -5, 2}, AspectRatio -> Automatic,
PlotStyle -> {Red, Green, Blue}, PlotLegend -> legends]
see help to customize the legend more. The above uses defaults.
http://reference.wolfram.com/mathematica/PlotLegends/tutorial/PlotLegends.html

Related

Adding Legend to multipe plots created with Show function

I have a function of 2 variables - F(x,n).
I need to plot it as a fuction of x for several n's at the same axes system.
I understand I can use Show function in this way (for F(x,a)=x^n):
Show[Table[Plot[x^n, {x, 0, 100}, PlotStyle -> ColorData[1][n]], {n, 10}],
PlotRange -> {All, 10^14}]
But I couldn't figure out how to add lengeds using the parameter n.
I am trying to avoide writing each legend "by hand"' because I need it for different sets of n, so I want it to be generated semi-automatically: I want to set the beginng of the string while the end of the string is depaned on the n. For the example I gave here it should be "F = x^n"...
I have tried using Table with ToString, but it didn't work (maybe I put it on the wronge places inside the Show function)
Thank you!
Is this what you want?
Show[Table[Plot[x^n,{x,0,100},PlotStyle->ColorData[1][n],
PlotLegends->{"F=x^"<>ToString[n]}],{n,10}],PlotRange->{All,10^14}]
You can apply legends without Show like so.
Using automatic expressions
Plot[Evaluate[Array[{x^#} &, 10]], {x, 0, 100},
PlotStyle -> ColorData[1], PlotRange -> {All, 10^14},
PlotLegends -> "Expressions"]
or with custom labels: "F = x^n"
legend = LineLegend[
Array[ColorData[1], 10],
Array["F = x^" <> ToString[#] &, 10]];
Plot[Evaluate[Array[{x^#} &, 10]], {x, 0, 100},
PlotStyle -> ColorData[1], PlotRange -> {All, 10^14},
PlotLegends -> legend]

Two-dimensional error bars with ErrorPlotList in Mathematica?

I am brand new to Mathematica and am having trouble putting two-dimensional error bars on a graph. I have a table with the data format: (r, sr, x, sx, y, sy) where r, x, and y are means and sr, sx, and sy are the standard deviations. I want to plot the x versus y columns and did this successfully with ListPlot:
Show[
ListPlot[meanlist[[All, {3, 5}]]], Graphics[Circle[{0, 0}, 20]],
PlotRange -> All, AspectRatio -> 1,
AxesLabel -> {Style["y [mm]", Bold, Medium],
Style["z [mm]", Bold, Medium]},
AxesOrigin -> {0, 0}]
If really necessary, I could leave it at that. However, I also want to add the x and y error bars. I tried doing this using ErrorListPlot:
ErrorListPlot[{{meanlist[[All, {3, 5}]]},
ErrorBar[meanlist[[All, {4, 6}]]]},
PlotRange -> All, AspectRatio -> 1,
AxesLabel -> {Style["y [mm]", Bold, Medium],
Style["z [mm]", Bold, Medium]},
AxesOrigin -> {0, 0},
ErrorBarFunction -> Automatic]
What I get out is the following (I truncated the two lists after the first line because they are long):
ErrorListPlot[{{{{-5.34473, -9.16194}, {-7.87379, -6.57843},...,
ErrorBar[{{0.501015, 0.72511}, {0.48202, 0.703881},...,
AxesLabel -> {Style["y [mm]", Bold, Medium],
Style["z [mm]", Bold, Medium]},
AxesOrigin -> {0, 0},
ErrorBarFunction -> Automatic]
In other words, it spits out lists of properly paired coordinates and error amounts followed by all the parameters I set for the graph, but it does not actually create a plot. I have included Needs["ErrorBarPlots`"]; and I'm no sure what else could be wrong. Any ideas?
try this:
ErrorListPlot[
{#[[{3, 5}]], ErrorBar[#[[4]], #[[6]]] } & /# meanlist ]
Aside, The final result you saw is typical of mathematica when you supply a function with invalid arguments, it repeats back what you entered rather than reporting an error.

histogram without vertical lines in Mathematica

I am trying to make an histogram without vertical lines. I'd like to have a plot which looks like a function. Like this:
The same question has been asked for R before ( histogram without vertical lines ) but I'm on Mathematica.
I have been looking into the ChartStyle options without success.
You could also use ListPlot with InterpolationOrder->0:
(* example data *)
data = RandomVariate[NormalDistribution[], 10^3];
hist = HistogramList[data, {.5}];
ListPlot[Transpose[{hist[[1]], ArrayPad[hist[[2]], {0, 1}, "Fixed"]}],
InterpolationOrder -> 0,
Joined -> True,
AxesOrigin -> {hist[[1, 1]], 0}]
There probably are ways to do this by fiddling with EdgeForm[] and FaceForm[] in Histogram, but I've found it simpler to roll one on my own, whenever I need it. Here's a very simple and quick example:
histPlot[data_, bins_, color_: Blue] := Module[{
countBorder =
Partition[Riffle[Riffle[#1, #1[[2 ;;]]], Riffle[#2, #2]], 2] & ##
HistogramList[data, bins, "PDF"]
},
ListLinePlot[countBorder, PlotStyle -> color]
]
Doing histPlot[RandomReal[NormalDistribution[],{1000}],{-3,3,0.1}] gives
You can then extend this to take any option instead of just "PDF", and for cases when you'd like to choose the bins automatically. I dislike automatic binning, because I like to control my bin widths and extents for predictability and easy comparison against other plots.
Here are two methods that work in version 7, using post-processing:
rdat = RandomReal[NormalDistribution[0, 1], 200];
MapAt[
{Blue,
Line[# /. {{Rectangle[{x_, y_}, {X_, Y_}]}} :> Sequence[{x, Y}, {X, Y}]] } &,
Histogram[rdat, PerformanceGoal -> "Speed"],
{1, 2, 2, 2}
]
Cases[
Histogram[rdat, PerformanceGoal -> "Speed"],
Rectangle[{x_, y_}, {X_, Y_}] :> {{x, Y}, {X, Y}},
\[Infinity]
];
Graphics[Line[Join ## %], AspectRatio -> 1/GoldenRatio, Axes -> True]

Match legend and Plot size

Please Consider :
intense = Reverse[Round[Rationalize /# N[10^Range[0, 3, 1/3]]]];
values = Range[0, 9/10, 1/10];
intensityLegend = Column[Prepend[MapThread[
Function[{intensity, values},
Row[{Graphics[{(Lighter[Blue, values]),
Rectangle[{0, 0}, {4, 1}], Black,
Text[Style[ToString[intensity], 16, Bold], {2, .5}]}]}]],
{intense, values}], Text[Style["Photons Number", Bold, 15]]]];
IntersectionDp1={{1., 588.377}, {2.15443, 580.306}, {4.64159, 573.466}, {10.,560.664},
{21.5443, 552.031}, {46.4159, 547.57}, {100.,545.051},
{215.443, 543.578}, {464.159, 542.281}, {1000., 541.346}}
FindD1=ListLogLinearPlot[Map[List, IntersectionDp1],
Frame -> True,
AxesOrigin -> {-1, 0},
PlotMarkers ->
With[{markerSize = 0.04}, {Graphics[{Lighter[Blue, #], Disk[]}],
markerSize} & /#Range[9/10, 0, -1/10]], Filling -> Axis,
FillingStyle -> Opacity[0.8],
PlotRange -> {{.5, 1100}, {540, 600}},
ImageSize->400];
Grid[{{intensityLegend, FindD1}, {intensityLegend, FindD1}},
ItemSize -> {50, 20}, Frame -> True]
How could I get the legend Column Size to Fit the Height of the Plot Area ?
While Row adjust the size I need to use Grid. This is why I duplicated in grid.
Working with Image Sizes. The (* <- *) marks the important modifications to your code, the rest are mainly font size thingies:
intense = Reverse[Round[Rationalize /# N[10^Range[0, 3, 1/3]]]];
values = Range[0, 9/10, 1/10];
imgSize = 400; (* <- *)
Off[Ticks::ticks]
IntersectionDp1 = {{1., 588.377}, {2.15443, 580.306}, {4.64159, 573.466},
{10., 560.664}, {21.5443, 552.031}, {46.4159, 547.57}, {100., 545.051},
{215.443, 543.578}, {464.159, 542.281}, {1000., 541.346}}
FindD1 = ListLogLinearPlot[Map[List, IntersectionDp1], Frame -> True,
AxesOrigin -> {-1, 0},
PlotMarkers ->
With[{markerSize = 0.04},
{Graphics[{Lighter[Blue, #], Disk[]}], markerSize} &
/# Range[9/10, 0, -1/10]], Filling -> Axis, FillingStyle -> Opacity[0.8],
PlotRange -> {{.5, 1100}, {540, 600}}, ImageSize -> imgSize]; (* <- *)
intensityLegend =
Rasterize[Column[
Prepend[
Reverse#MapThread[ (* <- *)
Function[{intensity, values},
Row[{Graphics[{(Lighter[Blue, values]),
Rectangle[{0, 0}, {4, 1}], Black,
Text[Style[ToString[intensity], 30, Bold], {2, .5}]}]}]],
{intense, values}],
Text[Style["Photons Number", Bold, 25]]]],
ImageSize -> {Automatic, (* <- *)
IntegerPart#
First[imgSize Cases[AbsoluteOptions[FindD1],
HoldPattern[AspectRatio -> x_] -> x]]}];
Grid[{{intensityLegend, FindD1}, {intensityLegend, FindD1}}, Frame -> True]
Where I reversed the intensities column for aesthetic purposes.
Edit
If you don't explicitly specify the ImageSize option for the Plot, you'll disappointingly find that AbsoluteOptions[Plot, "ImageSize"] returns "Automatic" !
Edit Answering the #500's comment bellow
The expression:
ImageSize -> {Automatic, (* <- *)
IntegerPart#
First[imgSize Cases[AbsoluteOptions[FindD1],
HoldPattern[AspectRatio -> x_] -> x]]}];
is really a working replacement for something that should work but doesn't to get the image size of a Plot:
ImageSize -> {Automatic, Last#AbsoluteOptions[FindD1,"ImageSize"]}
So, what the IntegerPart[...] thing is doing is getting the vertical size of the plot image, multiplying imgSize by the AspectRatio of the Plot.
To understand how it works, run the code and then type:
AbsoluteOptions[FindD1]
and you will see the Plot options there. Then the Cases[] function is just extracting the AspectRatio option.
In fact there is a cleaner way to do what the Cases[] does. It is:
AbsoluteOptions[FindD1,"AspectRatio"]
but there is another bug in the AbsoluteOptions function that prevents us to use it this way.
How about making the legend a bit smaller?
intensityLegend =
Column[Prepend[
MapThread[
Function[{intensity, values},
Row[{Graphics[{(Lighter[Blue, values]),
Rectangle[{0, 0}, {4, 1}], Black,
Text[Style[ToString[intensity], 12, Bold], {2, .5}]},
ImageSize -> 50]}]], {intense, values}],
Text[Style["Photons Number", Bold, 15]]]];

How to add custom ColorFunction in FillingStyle with Opacity

I want to plot a series of lines with one half-space filled for each line. By setting opacity to something less than 1, I want to make the overlaps stand out. What I have looks something like this:
Plot[Table[x + a, {a, 0, 5}], {x, -1/2, 1/2},
RegionFunction -> Function[{x, y}, y < 5],
Filling -> 5, FillingStyle -> Directive[Opacity[0.25]]]
This is fine. Now I want to also shade the colors for each half space in a particular way. Instead of the flat shading for each at present, say I want to shade it by the y value. I.e., if the flat shade color is blue, the shade of blue is scaled by y (0 most intense or 5 most intense doesn't matter). So at the first overlap, it automatically becomes 2y, 3y when two half-spaces overlay.
How do I do this?
You could try ParametricPlot. For example
ParametricPlot[
Table[{s, i + s/2 + t}, {i, 0, 2}], {s, 0, 1}, {t, 0, 3},
Mesh -> False, PlotStyle -> Automatic,
ColorFunctionScaling -> False,
PlotRange -> {Automatic, {0, 3}},
ColorFunction -> Function[{x, y, s, t},
Directive[Opacity[0.2], ColorData["NeonColors"][y/3]]],
AspectRatio -> 1]
Result:

Resources