Related
I have a data set with x,y and error(y) values. I write this in mathematica as:
Needs["ErrorBarPlots`"]
data = {{{0, 0.10981309359605919},
ErrorBar[0.05240427422664753`]}, {{0.2145, 0.09146326059113304},
ErrorBar[0.034195343626358385`]}, {{0.4290, 0.08230438177339898},
ErrorBar[0.02533205817067696`]}, {{0.6435, 0.0768141842364532},
ErrorBar[0.020205473852635995`]}, {{0.8580, 0.07223473349753692},
ErrorBar[0.016156209168991867`]}, {{4, 0.056122650246305375},
ErrorBar[0.009288720442961331]}};
ErrorListPlot[data, Frame -> True, FrameStyle -> Directive[Black, 20],
PlotRange -> {{-0.1, 5}, {0.2, 0}}, Axes -> False,
PlotStyle -> {Directive[Red, 12], AbsolutePointSize[10],
AbsoluteThickness[3]} , LabelStyle -> Directive[Green],
BaseStyle -> {Large, FontFamily -> "Courier", FontSize -> 12}]
But what I am trying to obtain is draw a line and get a shaded error band connecting the errorbars which obey a functional form, f(x)= 0.05 + 0.02/(x^2 + 0.425) . I don't want to show the error bars explicitly , rather I want to show the band. I am looking for something like this
I have looked at this link http://reference.wolfram.com/language/howto/GetResultsForFittedModels.html
but couldn't solve the problem. Could anyone please help me? Thanks.
Here is one approach, make two lists, one list for upper range of the erros:
dataPLUS = {{0, 0.10981309359605919 + 0.05240427422664753`}, {0.2145,
0.09146326059113304 + 0.034195343626358385`}, {0.4290,
0.08230438177339898 + 0.02533205817067696`}, {0.6435,
0.0768141842364532 + 0.020205473852635995`}, {0.8580,
0.07223473349753692 + 0.016156209168991867`}, {4,
0.056122650246305375 + 0.009288720442961331}};
another list for the lower range of the errors as:
dataMINUS = {{0, 0.10981309359605919 - 0.05240427422664753`}, {0.2145,
0.09146326059113304 - 0.034195343626358385`}, {0.4290,
0.08230438177339898 - 0.02533205817067696`}, {0.6435,
0.0768141842364532 - 0.020205473852635995`}, {0.8580,
0.07223473349753692 - 0.016156209168991867`}, {4,
0.056122650246305375 - 0.009288720442961331}};
Once you have the two sets you can use the ListPlot option as:
ListPlot[{dataPLUS, dataMINUS}, PlotStyle -> Red, PlotRange -> All]
which will generate a graph like
if you want to join them, instead use ListLinePlot option
ListLinePlot[{dataPLUS, dataMINUS}, PlotStyle -> Red,PlotRange -> All]
and to have a shaded region in between, use the Filling option
ListLinePlot[{dataPLUS, dataMINUS}, PlotStyle -> Red, Filling -> {1 -> {{2}, Gray}}, PlotRange -> All]
To get smooth graph, you need more data points. Hope this will help.
And to include the BestFit line, define a function and add to the previous plots as:
f[x_] = 0.05 + 0.02/(x^2 + 0.425);
plot2 = Plot[f[x], {x, 0, 5}, PlotStyle -> {Red, Thick}];
plot1 = ListLinePlot[{dataPLUS, dataMINUS}, PlotStyle -> LightGray,Filling -> {1 -> {{2}, LightGray}}, PlotRange -> All];
Show[{plot1, plot2}]
I am trying to plot a list of functions with a legend using PlotLegend in Mathematica v8. As a simple test illustrating what I'm trying to do.
<<PlotLegends`
test = Table[f[x], {f, {Sin, Cos, Tan, Log, Exp}}]
Plot[test, {x, 0, 1}, PlotRange -> Full, Axes -> {True, False},
PlotStyle -> Thick, AxesOrigin -> {0, 0},
PlotLegend -> {"Sin", "Cos", "Tan", "Log", "Exp"},
LegendPosition -> {0, -0.5}, LegendShadow -> None]
Gives as output
{Sin[x], Cos[x], Tan[x], Log[x], E^x}
However, if I explicitly put the table in the Plot command, I get the correct legend.
Plot[{Sin[x], Cos[x], Tan[x], Log[x], Exp[x]}, {x, 0, 1},
PlotRange -> Full, Axes -> {True, False}, PlotStyle -> Thick,
AxesOrigin -> {0, 0},
PlotLegend -> {"Sin", "Cos", "Tan", "Log", "Exp"},
LegendPosition -> {0, -0.5}, LegendShadow -> None]
For my actual application, I'm putting together a list of functions within a Do loop, so the latter Plot command is not ideal.
Any suggestions would be greatly appreciated.
Cheers,
Mike
Replace Plot[test, ...] with Plot[Evaluate#test, ...].
The problem is that Plot takes the first argument unevaluated and only evaluates it when calculating points. Therefore when it determines the labels, it only sees a single argument test, not a list, and therefore it only outputs one label. Evaluate#test tells Mathematica to evaluate test before passing it to Plot even though Plot is defined to take the argument unevaluated. This way, Plot sees the list you stored in test and knows to generate several labels.
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]
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
I have a graph as a result of executing ListPlot[] function.
I can manually edit this graph by moving points to a different location
and also adding new points using the Drawing Tools.
How do I get the coordinates of new and changed points from the edited graphics?
I'm not sure if the following is anything like what you want,but nevertheless:
If I use ListPlot as follows:
lp1 = Labeled[
ListPlot[Diagonal#Table[{x, y}, {x, 0, 5}, {y, 5}],
PlotStyle -> {Directive[Red, PointSize[Large]]}], "lp1"];
By double clicking on one of the red points twice to get the selection to the level of the points, I can then move the individual points, e.g., to make the points lie on a curve (rather than a straight line). I now want to extract these points (and say use them in a new ListPlot) [see plots below]
If I click on the bracket of the plot graphic and use "Show Expression" (Command Shift E on a Mac), I can 'see' the coordinates of the modified points which may then be extracted. For example:
expr = Cell[
BoxData[GraphicsBox[{RGBColor[1, 0, 0], PointSize[Large],
PointBox[{{0., 1.}, {0.8254488458250212,
2.886651181634783}, {1.9301795383300084`,
3.925201233010209}, {3.046546974446661,
4.597525796319094}, {4., 5.}}]},
AspectRatio -> NCache[GoldenRatio^(-1), 0.6180339887498948],
Axes -> True, PlotRange -> Automatic,
PlotRangeClipping -> True]], "Input",
CellChangeTimes -> {{3.504427833788156*^9, 3.50442786823486*^9}}];
Modifying a very useful approach originally suggested by Yaroslav Bulatov, which may be found here
modpoints = Flatten[Cases[expr, PointBox[___], Infinity][[All, 1]], {{2, 1}}]
EDIT
As pointed out by belisarius, it is desirable to be able to extract 'manually' added points (which may be added to the generated plot using 'point' from the Drawing Tools palette). A better way of extracting (after 'Show Expression' ...) is probably the following:
modpoints = Cases[Cases[expr, PointBox[___],
Infinity], {_?NumericQ, _?NumericQ}, Infinity]
Of course, 'Show Expression' is not the only approach.
InputForm is another possibility. For example,
expr2 = InputForm[ListPlotGraphic]
modpoints = Cases[Cases[expr, Point[___],
Infinity], {_?NumericQ, _?NumericQ}, Infinity]
where "ListPlotGraphic" is the modified graphic (inserted by 'copy and paste'), will also work.
Example plots
Addendum
The above can be automated with a little notebook programming:
lp1 = Labeled[
ListPlot[Diagonal#Table[{x, y}, {x, 0, 5}, {y, 5}],
PlotStyle -> {Directive[Red, PointSize[Large]]}],
Button["Print points",
With[{nb = ButtonNotebook[]},
SelectionMove[nb, All, CellContents];
Print[Cases[NotebookRead[nb],
PointBox[{{_?NumericQ, _?NumericQ} ..}] |
PointBox[{_?NumericQ, _?NumericQ}], Infinity]]]]]
Running the above, moving the last two original (red) points and adding a couple of extra points in blue with the drawing tools then pressing the button yields
You can see that there is a single PointBox for the original data and a new PointBox for each of the added points. Of course, by modifying the above code, you can do more than simply print out the raw point coordinates.
This approach makes every data point a locator that can be moved. New locators can be added and old ones deleted as appropriate. The best fit and variance are updated after every change.
Here's some data of some exponential growth with some errors and a data point missing
data = Delete[Table[{t, (1 + RandomReal[{-.2, .2}])Exp[t]}, {t, 0, 2, .2}], 6];
A little formatting command:
nForm = NumberForm[#, {2, 2}, NumberPadding -> {"", "0"}] &;
Finally, here's the code to make the manipulable graphics. New locators/data points are added using Alt-Click (or Ctrl-Alt-Click on linux). If you click on the list of points on the left, then a new window is opened containing the points in input form.
Manipulate[
LocatorPane[Dynamic[pts, {None, Temporary, Automatic}],
nlm = Block[{a,b,t}, NonlinearModelFit[Sort[pts], a Exp[t] + b, {a, b}, t]];
Show[Plot[{Exp[t], nlm[t]}, {t, 0, 2},
PlotStyle -> {{Thick, LightGray}, Dotted}, PlotRangePadding -> Scaled[0.1]],
ListPlot[data, PlotStyle -> Blue], AxesLabel -> Block[{t,f}, {t, f[t]}]],
LocatorAutoCreate -> True, Appearance -> Style["\[CircleDot]", Red]],
{nlm, None}, {{pts, data}, None},
Dynamic[Pane[EventHandler[
nForm#Grid[Prepend[pts, {"x", "y"}], Dividers -> {False, 2 -> True}],
{"MouseClicked" :> (CreateDocument[{ExpressionCell[nlm["Data"], "Output"]},
WindowTitle -> "Data"])}], ImageSize -> {100, 250},
ImageSizeAction -> "Scrollable", Scrollbars -> {False, True}]],
Pane[Dynamic[nForm#Row#{nlm,Row[{"\tvariance = ",nlm["EstimatedVariance"]}]}]],
ControlPlacement -> {Left, Left, Left, Top}]
In the above I've used the locators to correct a couple of outliers and restored the missing data point.
The easy option is to use the "Get Coordinates" menu option. If you right click on the graphic, in the pop-up menu you'll see "Get Coordinates" which allows you to mouse-over a point and see that point's coordinates. Of course this isn't going to be accurate... but the way you're editing the graphic isn't very accurate either.
You could use the InputForm (or FullForm) function, but I am not sure how well this works...
In[1]:= a = ListPlot[{{1, 0}, {0, 1}, {1, 1}}];
a // InputForm
Out[2]//InputForm=
Graphics[{{{}, {Hue[0.67, 0.6, 0.6], Point[{{1., 0.}, {0., 1.}, {1., 1.}}]},
{}}}, {AspectRatio -> GoldenRatio^(-1), Axes -> True, AxesOrigin -> {0, 0},
PlotRange -> {{0., 1.}, {0., 1.}}, PlotRangeClipping -> True,
PlotRangePadding -> {Scaled[0.02], Scaled[0.02]}}]
You'll notice that there's a Point expression in there.
The third option would be to use Locator in some way I guess.