Plot error band using functional form - wolfram-mathematica

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}]

Related

How can I show the steps of spring embedding in Mathematica?

I'm a really new user of Mathematica, and I'd need to show 9 images of a 10x10 grid graph to explain its partial transformation from a circular to a spring embedding, alligning the snapshots in a 3x3 table.
I've tried with this command:
Grid[Partition[Table[GraphPlot[
RandomGraph[{100, 100}, GraphLayout -> "CircularEmbedding"],
Method -> {"SpringEmbedding", "Rotation" -> True,
"RecursionMethod" -> None, MaxIterations -> i},
ImageSize -> 100], {i, 9}], {3}]]
But I got 9 times the same initial circular graph, just with slightly different positions, while I'm expected to return as the 9th figure a proper grid.
Thank you in advance for every suggestion
one other issue with your code is you generate a different random starting point for each figure. Fixing that, and going a few more iterations here is what I get:
rg = RandomGraph[{100, 100}, GraphLayout -> "CircularEmbedding"];
Grid[Partition[Table[GraphPlot[rg,
Method -> {"SpringEmbedding", "Rotation" -> True,
"RecursionMethod" -> None,
MaxIterations -> i},
ImageSize -> 100, AspectRatio -> 1], {i, 36}], {6}]]
rg = GridGraph[{10, 10}, GraphLayout -> "CircularEmbedding"];
Grid[Partition[
Table[GraphPlot[rg,
Method -> {"SpringEmbedding", "Rotation" -> True,
"RecursionMethod" -> None, MaxIterations -> i},
ImageSize -> 100, AspectRatio -> 1], {i, 16}], {4}]]
Also doesn't work on both 10.0.2 and 10.1!

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.

Force scientific notation in tick labels of Plot in mathematica

I am trying to scientific-format tick labels on a my Plot which is somehow a frame. By searching Mathgroup archives, it looks like the usual way to mess with tick labels is to extract them using AbsoluteOptions, run a replacement rule with the custom format, and then explicitly feed them to the plotting function with the Ticks->{...} option. However, the following doesn't work for FrameTicks:
makePlotLegend[names_, markers_, origin_, markerSize_, fontSize_,
font_] :=
Join ## Table[{Text[Style[names[[i]], FontSize -> fontSize, font],
Offset[{1.5*markerSize, -(i - 0.5)*
Max[markerSize, fontSize]*1.25}, Scaled[origin]], {-1, 0}],
Inset[Show[markers[[i]], ImageSize -> markerSize],
Offset[{0.5*markerSize, -(i - 0.5)*
Max[markerSize, fontSize]*1.25}, Scaled[origin]], {0, 0},
Background -> Directive[Opacity[0], White]]}, {i, 1,
Length[names]}];
LJ[r_] := 4 e ((phi/r)^12 - (phi/r)^6)
phi = 2.645;
e = 10.97 8.621738 10^-5;
l1 = Plot[LJ[r], {r, 2, 11}, PlotStyle -> {Blue},
PlotRange -> {{2, 6}, {0.001, -0.002}}, Frame -> True,
LabelStyle -> {8},
Epilog ->
makePlotLegend[{"He-He",
"H-H"}, (Graphics[{#, Line[{{-1, 0}, {1, 0}}]}]) & /# {Blue,
Red}, {0.80, 0.35}, 7.5, 7.3, "Times New Roman"]]

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]]]];

Specify Point Style in ListPlot in Mathematica

Considering
dacount = {{0, 69}, {1, 122}, {2, 98}, {3, 122}, {4, 69}}
ListPlot[dacount, AxesOrigin -> {-1, 0},
PlotMarkers ->Automatic
PlotStyle-> Lighter[Red, #] & /# Range[0.5, 1, 0.1],
Filling -> Axis, FillingStyle -> Opacity[0.8],
PlotRange -> {{-1, 4.5}, {0, 192}}]
My hope there was for each point to take a different shade of red.
But I can`t understand how to have a style for point which I tried to set as different list.
In your original code, the PlotStyle option won't affect the marker symbols, so you can leave it out. Instead, change your PlotMarkers option to the following:
PlotMarkers -> With[{markerSize = 0.04},
{Graphics[{Lighter[Red, #], Disk[]}], markerSize} & /# Range[0.5, 1, 0.1]]
This will not yet have the desired effect until you replace the list dacount by:
Map[List, dacount]
By increasing the depth of the point list in this way, each point is assigned a marker style of its own from the list in PlotMarkers. So the final code is:
ListPlot[Map[List, dacount], AxesOrigin -> {-1, 0},
PlotMarkers ->
With[{markerSize =
0.04}, {Graphics[{Lighter[Red, #], Disk[]}], markerSize} & /#
Range[0.5, 1, 0.1]], Filling -> Axis,
FillingStyle -> Opacity[0.8], PlotRange -> {{-1, 4.5}, {0, 192}}]
You can also do it the following way:
xMax = Max#dacount[[All, 1]];
Show#(ListPlot[{#}, AxesOrigin -> {-1, 0}, PlotMarkers -> Automatic,
PlotStyle -> (RGBColor[{(#[[1]] + 5)/(xMax + 5), 0, 0}]),
Filling -> Axis, FillingStyle -> Opacity[0.8],
PlotRange -> {{-1, 4.5}, {0, 192}}] & /# dacount)
This plots each point in dacount individually and assigns it a shade of red depending on the x value. The plots are then combined with Show.
I've arbitrarily chosen a scaling and offset for the different shades. You can choose whatever you want, as long as you ensure that the max value is 1.

Resources