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 would like to highlight the fit region in a mathematica graph with appropriate fit error bar on it. To plot some data with error bar I write for example:
data={{{0, 0.00126517235028},
ErrorBar[0.0097546177348]}, {{1, 0.0132870239578},
ErrorBar[0.00717311242327]}, {{2, 0.00968907928987},
ErrorBar[0.0125454440978]}, {{3, 0.00835906062474},
ErrorBar[0.0196027916911]}, {{4, 0.0141038637039},
ErrorBar[0.0288324766544]}, {{5, 0.0467626302256},
ErrorBar[0.0423090450838]}, {{6, 0.0832535249208},
ErrorBar[0.0609066442506]}};
ErrorListPlot[p0all67, Frame -> True,
PlotRange -> {{0, 6}, {0.3, -0.04}}, Axes -> False,
PlotStyle -> {AbsolutePointSize[10], AbsoluteThickness[2]}]
Now I fit the data in anther software using linear fit method and for example, the fit result(or slope) in x=4 to x=6 is 0.0317349, and error bar is 0.0215005. I would like to highlight the fit region with this fit value and the error. So i expect the graph to look something like this:
Could anybody please help me how to do this? Thanks.
Needs["ErrorBarPlots`"];
data = {{{0, 0.00126517235028},
ErrorBar[0.0097546177348]}, {{1, 0.0132870239578},
ErrorBar[0.00717311242327]}, {{2, 0.00968907928987},
ErrorBar[0.0125454440978]}, {{3, 0.00835906062474},
ErrorBar[0.0196027916911]}, {{4, 0.0141038637039},
ErrorBar[0.0288324766544]}, {{5, 0.0467626302256},
ErrorBar[0.0423090450838]}, {{6, 0.0832535249208},
ErrorBar[0.0609066442506]}};
elp = ErrorListPlot[data, Frame -> True,
PlotRange -> {{0, 6}, {-0.05, 0.18}}, Axes -> False,
PlotStyle -> {AbsolutePointSize[7], AbsoluteThickness[1]},
PlotRangePadding -> {0.4, 0}];
m = 0.0317349;
line[x_, c_] := m x + c;
{x4, y4} = data[[5, 1]];
ytest = line[x4, 0];
c = y4 - ytest;
check = line[x4, c];
x6 = 6;
y6 = line[x6, c];
delta = 0.0215005;
a = {{x4, y4 + delta}, {x6, y6 + delta}};
b = {{x4, y4 - delta}, {x6, y6 - delta}};
Show[elp,
ListLinePlot[{{x4, y4}, {x6, y6}}, PlotStyle -> Thick],
ListLinePlot[{a, b}, Filling -> {1 -> {2}}, PlotStyle -> None],
ImageSize -> 500]
Here is also an example based on your data demonstrating some statistics functions.
data = {0.00126517235028, 0.0132870239578, 0.00968907928987,
0.00835906062474, 0.0141038637039, 0.0467626302256, 0.0832535249208};
lm = LinearModelFit[data, {1, x , x^2, x^3}, x];
{sd1, sd2} = 2*(CDF[NormalDistribution[0, 1], #] - 0.5) & /# {1, 2};
intervals = Flatten[Transpose /# Table[
lm["SinglePredictionConfidenceIntervals", ConfidenceLevel -> cl],
{cl, {sd1, sd2}}], 1];
{bands68[x_], bands95[x_]} = Table[
lm["SinglePredictionBands", ConfidenceLevel -> cl], {cl, {sd1, sd2}}];
Show[ListPlot[data, PlotMarkers -> Automatic], ListPlot[intervals],
Plot[{lm[x], bands68[x], bands95[x]}, {x, 5, 8}, Filling -> {2 -> {1}, 3 -> {2}}],
PlotRange -> {{1, 7}, {-0.02, 0.1}}, ImageSize -> 480, Frame -> True, Axes -> False]
So I have a set of bounded diophantine equations that specify lines on the plane. I want to make mathematica plot the intersection of two of these equations so I can see what they look like.
So far I have something like:
Solve[0 < x - y < 3 && -1 < 2 x - y < 2, {x, y}, Integers]
which returns some structure like:
{{x -> -2, y -> -4}, {x -> -1, y -> -3}, {x -> -1, y -> -2}, {x -> 0,
y -> -1}}
but how can I now make mathematica plot this so I can see the resulting shape. Preferably I would like the plot to consider every 'point' to be a 1x1 square.
Also, I wonder if there is a better way to do such things. Thanks.
Define the data you wish to plot by transforming the list Solve[] returns. This can done as
data = {x, y} /. Solve[0 < x - y < 3 && -1 < 2 x - y < 2, {x, y}, Integers]
More generally, you can make Solve return the solution in a list format (rather than as a set of rules) using the following trick:
data = Solve[0 < x - y < 3 && -1 < 2 x - y < 2, {x, y}, Integers] /. Rule[a_,b_]->b
For plotting, among many alternatives, you can use ListPlot as
ListPlot[data, PlotMarkers -> {Style["\[FilledSquare]", FontSize -> 16]}]
to get the following output
You can further refine it using many styling and other options of ListPlot. For example, you can join the points
ListPlot[data, PlotMarkers -> {Style["\[FilledSquare]", FontSize -> 16]},
Joined -> True]
to get
EDIT: To play with the marker placement and size there are several alternatives. Using ListPlot you can get what you need in either of the two ways:
(* Alternative 1: use fontsize to change the marker size *)
lp1 := ListPlot[{#} & /# #1,
PlotMarkers -> {Style["\[FilledSquare]", FontSize -> Scaled[#2]]},
AspectRatio -> 1, AxesOrigin -> {0, 0},
PlotRange -> {{-5, 1}, {-5, 1}},
PlotStyle -> Hue /# RandomReal[1, {Length##1}],
Epilog -> {GrayLevel[.3], PointSize[.02], Point##1, Thick,
Line##1}, Frame -> True, FrameTicks -> All] &;
(* usage example *)
lp1 ## {data, .30}
(* Alternative 2: use the second parameter of PlotMarkers to control scaled size *)
lp2 := ListPlot[{#} & /# #1,
PlotMarkers -> {Graphics#{Rectangle[]}, #2}, AspectRatio -> 1,
AxesOrigin -> {0, 0}, PlotRange -> {{-5, 1}, {-5, 1}},
PlotStyle -> Hue /# RandomReal[1, {Length##1}],
Epilog -> {GrayLevel[.3], PointSize[.02], Point##1, Thick,
Line##1}, Frame -> True, FrameTicks -> All] &
(* usage example *)
lp2 ## {data, 1/5.75}
In both cases, you need to use Epilog, otherwise the lines joining points are occluded by the markers. Both alternatives produce the following output:
Alternatively, you can use Graphics, RegionPlot, ContourPlot, BubbleChart with appropriate transformations of data to get results similar to the one in ListPlot output above.
Using Graphics primitives:
(* data transformation to define the regions *)
trdataG[data_, size_] := data /. {a_, b_} :>
{{a - size/2, b - size/2}, {a + size/2, b + size/2}};
(* plotting function *)
gr := Graphics[
{
{Hue[RandomReal[]], Rectangle[##]} & ### trdataG ## {#1, #2},
GrayLevel[.3], PointSize[.02], Thick, Point##1, Line##1},
PlotRange -> {{-5, 1}, {-5, 1}
},
PlotRangePadding -> 0, Axes -> True, AxesOrigin -> {0, 0},
Frame -> True, FrameTicks -> All] &
(* usage example *)
gr ## {data, .99}
Using BubbleChart:
(* Transformation of data to a form that BubbleChart expects *)
dataBC[data_] := data /. {a_, b_} :> {a, b, 1};
(* custom markers *)
myMarker[size_][{{xmin_, xmax_}, {ymin_, ymax_}}, ___] :=
{EdgeForm[], Rectangle[{(1/2) (xmin + xmax) - size/2, (1/2) (ymin + ymax) -
size/2}, {(1/2) (xmin + xmax) + size/2, (1/2) (ymin + ymax) + size/2}]};
(* charting function *)
bc := BubbleChart[dataBC[#1], ChartElementFunction -> myMarker[#2],
ChartStyle -> Hue /# RandomReal[1, {Length##1}], Axes -> True,
AxesOrigin -> {0, 0}, PlotRange -> {{-5, 1}, {-5, 1}},
PlotRangePadding -> 0, AspectRatio -> 1, FrameTicks -> All,
Epilog -> {GrayLevel[.3], PointSize[.02], Point##1, Thick, Line##1}] &
(* usage example *)
bc ## {data, .99}
Using RegionPlot:
(* Transformation of data to a form that RegionPlot expects *)
trdataRP[data_, size_] := data /. {a_, b_} :>
a - size/2 <= x <= a + size/2 && b - size/2 <= y <= b + size/2
(* charting function *)
rp := RegionPlot[Evaluate#trdataRP[#1, #2], {x, -5, 1}, {y, -5, 1},
AspectRatio -> 1, Axes -> True, AxesOrigin -> {0, 0},
PlotRange -> {{-5, 1}, {-5, 1}},
PlotStyle -> Hue /# RandomReal[1, {Length##1}], FrameTicks -> All,
PlotPoints -> 100, BoundaryStyle -> None,
Epilog -> {GrayLevel[.3], PointSize[.02], Point##1, Thick, Line##1}] &
(* usage example *)
rp ## {data, .99}
Using ContourPlot:
(* Transformation of data to a form that ContourPlot expects *)
trdataRP[data_, size_] := data /. {a_, b_} :>
a - size/2 <= x <= a + size/2 && b - size/2 <= y <= b + size/2;
trdataCP[data_, size_] := Which ## Flatten#
Thread[{trdataRP[data, size], Range#Length#data}];
(* charting function *)
cp := ContourPlot[trdataCP[#1, #2], {x, -5, 1}, {y, -5, 1},
AspectRatio -> 1, Axes -> True, AxesOrigin -> {0, 0},
PlotRange -> {{-5, 1}, {-5, 1}}, FrameTicks -> All,
ExclusionsStyle -> None, PlotPoints -> 100,
ColorFunction -> Hue,
Epilog -> {GrayLevel[.3], PointSize[.02], Point##1, Thick, Line##1}] &
(* usage example *)
cp ## {data, .99}
may be
sol = Solve[0 < x - y < 3 && -1 < 2 x - y < 2, {x, y}, Integers];
pts = Cases[sol, {_ -> n_, _ -> m_} :> {n, m}];
ListPlot[pts, Mesh -> All, Joined -> True, AxesOrigin -> {0, 0},
PlotMarkers -> {Automatic, 10}]
Can also extract the points to plot using
{#[[1, 2]], #[[2, 2]]} & /# sol
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
Inspired by this question at ask.sagemath, what is the best way of adding arrows to the end of curves produced by Plot, ContourPlot, etc...? These are the types of plots seen in high school, indicating the curve continues off the end of the page.
After some searching, I could not find a built-in way or up-to-date package to do this. (There is ArrowExtended, but it's quite old).
The solution given in the ask.sagemath question relies on the knowledge of the function and its endpoints and (maybe) the ability to take derivatives. Its translation into Mathematica is
f[x_] := Cos[12 x^2]; xmin = -1; xmax = 1; small = .01;
Plot[f[x],{x,xmin,xmax}, PlotLabel -> y==f[x], AxesLabel->{x,y},
Epilog->{Blue,
Arrow[{{xmin,f[xmin]},{xmin-small,f[xmin-small]}}],
Arrow[{{xmax,f[xmax]},{xmax+small,f[xmax+small]}}]
}]
An alternative method is to simply replace the Line[] objects generate by Plot[] with Arrow[]. For example
Plot[{x^2, Sin[10 x], UnitStep[x]}, {x, -1, 1},
PlotStyle -> {Red, Green, {Thick, Blue}},
(*AxesStyle -> Arrowheads[.03],*) PlotRange -> All] /.
Line[x__] :> Sequence[Arrowheads[{-.04, .04}], Arrow[x]]
But this has the problem that any discontinuities in the lines generate arrow heads where you don't want them (this can often be fixed by the option Exclusions -> None). More importantly, this approach is hopeless with CountourPlots. Eg try
ContourPlot[x^2 + y^3 == 1, {x, -2, 2}, {y, -2, 1}] /.
Line[x__] :> Sequence[Arrowheads[{-.04, .04}], Arrow[x]]
(the problems in the above case can be fixed by the rule, e.g., {a___, l1_Line, l2_Line, b___} :> {a, Line[Join[l2[[1]], l1[[1]]]], b} or by using appropriate single headed arrows.).
As you can see, neither of the above (quick hacks) are particularly robust or flexible. Does anyone know an approach that is?
The following seems to work, by sorting the segments first:
f[x_] := {E^-x^2, Sin[10 x], Sign[x], Tan[x], UnitBox[x],
IntegerPart[x], Gamma[x],
Piecewise[{{x^2, x < 0}, {x, x > 0}}], {x, x^2}};
arrowPlot[f_] :=
Plot[{#}, {x, -2, 2}, Axes -> False, Frame -> True, PlotRangePadding -> .2] /.
{Hue[qq__], a___, x___Line} :> {Hue[qq], a, SortBy[{x}, #[[1, 1, 1]] &]} /.
{a___,{Line[x___], d___, Line[z__]}} :>
List[Arrowheads[{-.06, 0}], a, Arrow[x], {d},
Arrowheads[{0, .06}], Arrow[z]] /.
{a___,{Line[x__]}}:> List[Arrowheads[{-.06, 0.06}], a, Arrow[x]] & /# f[x];
arrowPlot[f]
Inspired by both Alexey's comment and belisarius's answers, here's my attempt.
makeArrowPlot[g_Graphics, ah_: 0.06, dx_: 1*^-6, dy_: 1*^-6] :=
Module[{pr = PlotRange /. Options[g, PlotRange], gg, lhs, rhs},
gg = g /. GraphicsComplex -> (Normal[GraphicsComplex[##]] &);
lhs := Or##Flatten[{Thread[Abs[#[[1, 1, 1]] - pr[[1]]] < dx],
Thread[Abs[#[[1, 1, 2]] - pr[[2]]] < dy]}]&;
rhs := Or##Flatten[{Thread[Abs[#[[1, -1, 1]] - pr[[1]]] < dx],
Thread[Abs[#[[1, -1, 2]] - pr[[2]]] < dy]}]&;
gg = gg /. x_Line?(lhs[#]&&rhs[#]&) :> {Arrowheads[{-ah, ah}], Arrow##x};
gg = gg /. x_Line?lhs :> {Arrowheads[{-ah, 0}], Arrow##x};
gg = gg /. x_Line?rhs :> {Arrowheads[{0, ah}], Arrow##x};
gg
]
We can test this on some functions
Plot[{x^2, IntegerPart[x], Tan[x]}, {x, -3, 3}, PlotStyle -> Thick]//makeArrowPlot
And on some contour plots
ContourPlot[{x^2 + y^2 == 1, x^2 + y^2 == 6, x^3 + y^3 == {1, -1}},
{x, -2, 2}, {y, -2, 2}] // makeArrowPlot
One place where this fails is where you have horizontal or vertical lines on the edge of the plot;
Plot[IntegerPart[x],{x,-2.5,2.5}]//makeArrowPlot[#,.03]&
This can be fixed by options such as PlotRange->{-2.1,2.1} or Exclusions->None.
Finally, it would be nice to add an option so that each "curve" can arrow heads only on their boundaries. This would give plots like those in Belisarius's answer (it would also avoid the problem mentioned above). But this is a matter of taste.
The following construct has the advantage of not messing with the internal structure of the Graphics structure, and is more general than the one suggested in ask.sagemath, as it manage PlotRange and infinities better.
f[x_] = Gamma[x]
{plot, evals} =
Reap[Plot[f[x], {x, -2, 2}, Axes -> False, Frame -> True,
PlotRangePadding -> .2, EvaluationMonitor :> Sow[{x, f[x]}]]];
{{minX, maxX}, {minY, maxY}} = Options[plot, PlotRange] /. {_ -> y_} -> y;
ev = Select[evals[[1]], minX <= #[[1]] <= maxX && minY <= #[[2]] <= maxY &];
seq = SortBy[ev, #[[1]] &];
arr = {Arrow[{seq[[2]], seq[[1]]}], Arrow[{seq[[-2]], seq[[-1]]}]};
Show[plot, Graphics[{Red, arr}]]
Edit
As a function:
arrowPlot[f_, interval_] := Module[{plot, evals, within, seq, arr},
within[p_, r_] :=
r[[1, 1]] <= p[[1]] <= r[[1, 2]] &&
r[[2, 1]] <= p[[2]] <= r[[2, 2]];
{plot, evals} = Reap[
Plot[f[x], Evaluate#{x, interval /. List -> Sequence},
Axes -> False,
Frame -> True,
PlotRangePadding -> .2,
EvaluationMonitor :> Sow[{x, f[x]}]]];
seq = SortBy[Select[evals[[1]],
within[#,
Options[plot, PlotRange] /. {_ -> y_} -> y] &], #[[1]] &];
arr = {Arrow[{seq[[2]], seq[[1]]}], Arrow[{seq[[-2]], seq[[-1]]}]};
Show[plot, Graphics[{Red, arr}]]
];
arrowPlot[Gamma, {-3, 4}]
Still thinking what is better for ListPlot & al.