New answers tagged plotting
0
One way may be to use custom markers. For example,
centeredPolygon[coords_] :=Polygon[coords] /. {x_, y_} -> {x, y} -RegionCentroid[Polygon[coords]];
vertexUpFilledTriangle = Graphics[{Darker[Blue], centeredPolygon[{{1, 0}, {0, Sqrt[3]}, {-1, 0}}]},ImageSize -> 8];
circle1 = Graphics[{Red, Circle[]}, ImageSize -> 8];
Then
ListLogPlot[{data1, ...
0
An alternative way to generate m:
ClearAll[l, n, k, j]
m2 = {n, j, k, l} /. Solve[{Total[{l, n, k, j}^Range[4]] == 0,
-10 <= l <= 0 && -10 <= k <= 0 && 0 <= n <= 10 && 0 <= j <= 10},
{n, j, k, l}, Integers];
m2 == m
True
new2 = ArrayReshape[
MapIndexed[Flatten[{#[[;; 2]], .01 #2[[1]], #[[3 ;;]]...
2
funcs = {Sin, Cos, Exp};
tbl = Table[Table[{x, i, funcs[[i]][x]}, {x, 0, 2 π, 0.1}], {i, 3}];
ListPointPlot3D[tbl, BoxRatios -> 1, PlotLegends -> funcs]
2
Something like this?
Join @@ MapIndexed[Partition[#1, 2] /. x_?VectorQ :> Join[x, 0.01 #2] &, m]
ListPlot3D[%, PlotStyle -> PointSize[0.02]]
{{0, 0, 0.01}, {0, 0, 0.01}, {0, 1, 0.02}, {-1, 0, 0.02}, {0, 1,
0.03}, {0, -1, 0.03}, {0, 2, 0.04}, {-2, -8, 0.04}, {1, 0,
0.05}, {-1, 0, 0.05}, {1, 0, 0.06}, {0, -1, 0.06}, {1, 1,
0.07}, {-...
0
If I understand correctly this is what you want. Not elegant though.
list = Flatten[ Outer[List, Range[0, 10], Range[0, 10], Range[-10, 0], Range[-10, 0]], 3];
m = Pick[list, #1^2 + #2^4 + #3^3 + #4 & @@@ list, 0]
a = 0.01 Range[Length@m];
new = ArrayReshape[Transpose@Insert[Transpose@m, a, {{3}, {5}}], {2 Length@m, 3}]
ListPointPlot3D[new]
1
To find PlotRange for each plot, run
Options[ab, PlotRange]
Options[bc, PlotRange]
Then adjust your code as follows:
spCnts1 = {12.5, 17.8, 19.9, 21.40, 25.6, 28.4, 29.5, 30.2, 35.1,
40.1, 46.4, 47.5, 48.3, 50.2, 53.2, 55.9, 56.3, 57.51, 60.3, 62.3,
65.4, 66.4, 68.60, 71.2};
ab = ProbabilityScalePlot[spCnts1, "LogNormal", ImageSize -> Medium,
...
3
The Show command uses the options from the first graphic that you feed to it, see here
This explains why when you are re-ordering the graphics you get different results. It is to be expected.
In order to fix that: since, show knows what it is doing just don't use the PlotRange command.
The following piece of code
pl1 = Plot[(5*10^15)/x, {x, 10^(-7), ...
3
To use DateHistogram instead of BarChart (so that the chart and the timeline plot share a common date axis) we construct a list of WeightedData objects:
wd = WeightedData[data[[All, {1}]], data[[All, #]]] & /@ {2, 3, 4};
To use the graphics primitives produced by TimelinePlot as Epilog in DateHistogram we need to modify the vertical scales and ...
0
I tried just :
ListLinePlot[
Table[#, {u, 0, Pi, Pi/100}] & /@ {{u + Sin[u], -Cos[u]},
{u + Sin[u + Pi], Cos[u + Pi]}},
Filling -> {1 -> {2}}, FillingStyle -> Green[.95]];
And it made the same figure but the color of filling is blue between the curves. So why do you need the transpose version also?
1
T = 1/2;
β = 1/T;
B = 2;
J = 1;
δ = Sqrt[DM^2 + J^2];
θ0 = ArcTan[DM/J];
Z = 2*Cosh[2*B*β] + 2*Cosh[2*β*δ];
SqRho = {{E^((-B)*β), 0, 0, 0}, {0, Cosh[β*δ], (-E^(I*θ0))*Sinh[β*δ], 0},
{0, (-E^((-I)*θ0))*Sinh[β*δ], Cosh[β*δ], 0}, {0, 0, 0, E^(B*β)}}/Sqrt[Z];
χ = {{Cos[θ], 0, Cos[ϕ]*Sin[θ] - I*Sin[θ]*Sin[ϕ], 0},
{0, Cos[θ], 0, Cos[ϕ]*...
5
Numerically all 100 differences between 100 corresponding elements of matrices correspond fall into just 5 symmetric values:
Round[Union[Flatten[mat1-mat2]],.0001]
{-0.0025,-0.0019,-0.0015,-0.001,0.,0.001,0.0015,0.0019,0.0025}
Which looks a lot like some small noise imposed on:
{-25,-20,-15,-10,0,10,15,20,25}/10000
It is actually quite easy to ...
2
There is no need to use NIntegrate:
X = NDSolveValue[{x''[t] + 2 x'[t] + x[t] == 0, x[0] == 1,x'[0] == -4}, x, {t, 0, 2}]
Plot[Integrate[Exp[y X[t]], {y, 1, 10}],{t,0,2}]
0
Clear["Global`*"]
eqns = {x''[t] + 2 x'[t] + x[t] == 0, x[0] == 1, x'[0] == -4};
In defining f use Set rather than SetDelayed
f = NDSolve[eqns, x, {t, 0, 2}][[1]]
g[t_?NumericQ] :=
NIntegrate[Exp[y*x[t] /. f], {y, 1, 10}]
For comparison, the exact solution of the differential equation is
sol = DSolve[eqns, x, t][[1]]
(* {x -> Function[{t}, -E^-t (-...
3
Knowing the elliptic constraint ( X1/Cos[x0)^2+( X2/Sin[x0)^2==1 (see my comment) the parametric form of the planes x0==const is
x1=Cos[x0] Cos[t];
x2=Sin[x0] Sin[t];
p[t_, x0_] := Evaluate[ {x1, x2, x0 + x1 + x2} ]
ParametricPlot3D gives the plot
ParametricPlot3D[p[t, 0.5], {t, 0, 2 Pi},AxesLabel -> {"x1", "x2", "x"}]
you're looking for!
2
A useful piece of advice. Before putting many commands in the same cell, try to run each one individually to make sure that there are no errors. This time it was the first NDSolve causing something. The following code works
f1 = NDSolve[{x''[t] + 2 x'[t] + x[t] == 0, x[0] == 1, x'[0] == -4},
x, {t, 0, 2}]
Plot[x[t] /. f1, {t, 0, 2}]
And then,the ...
6
For plotting all your parameters need to be numerically defined. Please read docs a bit on plotting as this is quite simple. You got Inactive sum that you should Activate. Use Evaluate inside plotting functions to speedup plotting up. Read up docs on all functions I mentioned and used.
Plot3D[Evaluate[Activate[sol /. K -> 1]], {x, -5, 5}, {t, 0, 2}, ...
8
A simple version on the subject. You can adopt this to your purposes.
f[x_]:=(x^2+2x+2)/(x+1);
a[x_]:=x+1;
Manipulate[
Plot[{f[x],a[x]},{x,-11,7},
Epilog->{Blue, Thick,Line[{{s,a[s]},{s,f[s]}}],
PointSize[.015],Point[{{s,f[s]},{s,a[s]}}]},
Exclusions->{-1},
ExclusionsStyle->Directive[Purple,Thick,Dashed],
PlotStyle->{Black,Directive[Red,...
4
I think it's the other isocline that needs to be vertical. Setting the first equation ($dx/dt$) equal to zero, you get $y=r/a$ (or the trivial $x=0$). Setting the second ($dy/dt$) equal to zero, you get $x=d/(fa)$.
You can't Plot a vertical line, since it isn't a function. One dirty trick is to plot one with a very large slope instead. For example,
...
6
Transform your conditions to cylindrical coordinates
cond =
x^2 + (y - 1)^2 < 1 &&0 < z < x^2 + y^2 /. {x -> r Cos[φ], y -> r Sin[φ]} //
FullSimplify[#, {r > 0, -Pi < φ < Pi}] &
(*r < 2 Sin[φ] && 0 < z < r^2*)
to get the integration limits!
The first condition (remember r > 0) implies 0 < ...
4
You can visualize the region of integration as follows if specified in rectangular / Cartesian coordinates. I am looking for a way to specify in cylindrical to the plot directly and will update when I find it.
With[{
Δ=0.1
},
RegionPlot3D[And[
x^2+(y-1)^2<=1,
z<=x^2+y^2,
z>=0
],
{x,-1-Δ,1+Δ},
{y,0-...
5
Take columns 2-thru-5 and re-arrange the columns:
d = data[[All, {3, 4, 5, 2}]];
You can use the 4D data with BubbleChart3D with the options BubbleSizes -> {s, s} (so that bubble sizes are the same for all data points) and ColorFunction -> "BlueGreenYellow" (so that bubble color is determined by the -automatically scaled- last column):
...
2
You can pre-define the colors for each point, using normalized values from column 2:
normd = Table[(p - Min[data2[[All, 2]]])/(Max[data2[[All, 2]]] - Min[data2[[All, 2]]]), {p, data2[[All, 2]]}];
colors = Table[ColorData["BlueGreenYellow"][d], {d, normd}]
ListPointPlot3D[{#[[3 ;; 5]]} & /@ data2, PlotStyle -> colors, PlotRange -> All]
(* or *)
...
2
Pick might help. Also, here a way to perform everything a bit more efficiently (because this uses packed arrays).
pts = Tuples[ConstantArray[Subdivide[-2., 2., 40], 3]];
boole = UnitStep@Subtract[1., Dot[pts^2, ConstantArray[1., 3]]];
Graphics3D[Point[Pick[pts, boole, 1]]]
This uses the coordinates from the list pts to place the points in $\mathbb{R}^3$. ...
3
Instead of using 1 and 0 to mark your selected points, you could instead directly generate the point triple that satisfies your condition, and use Nothing otherwise. For example:
ListPointPlot3D[Flatten[Table[If[i^2 + j^2 + z^2 <= 1, {i, j, z}, Nothing],
{i, -2, 2, 0.1}, {j, -2, 2, 0.1}, {z, -2, 2, 0.1}], 2],
...
3
table = Table[If[i^2 + j^2 + z^2 <= 1, 1, 0], {i, -2, 2, 0.1}, {j, -2, 2,
0.1}, {z, -2, 2, 0.1}];
If you want to get the 3D coordinates from positions of 1 in table you can use Position
coords1 = Position[table, 1];
ListPointPlot3D[coords1, BoxRatios -> 1]
Alternatively, you can make table a SparseArray and use the property "NonzeroPositions"...
2
Draw extra boundary. Is slightly faster.
cond = (x - 45/2)^2 + y^2 + z^2 >= 25/4 && (x - 15)^2 + y^2 + z^2 >=
25 && (x - 35/2)^2 + y^2 + z^2 <= 225/4;
cond2 = List @@ (Equal @@ # & /@ cond)
rp = RegionPlot3D[cond, {x, 10, 25}, {y, 0, 8}, {z, -8, 8},
PlotPoints -> 100];
cp = ContourPlot3D[
Evaluate[...
3
NIntegrate does not recognize R and L in the integrand. Define it explicitly in your functions:
rCMid[x_, y_, z_, \[Phi]1_, z1_, R_] = {x - R*Cos[\[Phi]1],
y - R*Sin[\[Phi]1], z - z1}
rCNormMid[x_, y_, z_, \[Phi]1_, z1_, R_] =
Sqrt[x^2 + y^2 + z^2 + z1^2 + R^2 - 2*z*z1 -
2*R*(x*Cos[\[Phi]1] + y*Sin[\[Phi]1])]
rCTop[x_, y_, z_, r1_, \[Phi]1_, L_] = {x - ...
1
The OP's solution is doing too much work. In fact, this picture can be generated with a single Plot3D[] call, through the judicious use of Min[] and a straightforward ColorFunction construction:
Plot3D[Min[Sqrt[1 - x^2], 1 - y/2], {x, -1, 1}, {y, 0, 2},
ColorFunction -> Function[{x, y, z}, If[(1 - y/2)^2 < 1 - x^2, Blue, Red]],
...
1
I wanted to briefly answer the side issue you had, ie. units not being displayed on your axes.
Turns out that you have to change the PlotTheme to "Web" (just like the example here shows) in order for the units to be displayed.
I have not experimented with other themes so PlotTheme -> "Web" might not be unique.
Edit: Turns out you also have to use ...
1
I made a little change to the four times Abs[w1]. Think it was a typo.
\[CapitalLambda]u = {{\[Theta], \[Phi], 0, 2*\[Theta]},
{0, 6, 8*DM, \[Phi]}, {0, DM + 42, \[Theta], 0},
{5, 0, \[Phi], 20}}
{\[Omega]1, \[Omega]2, \[Omega]3, \[Omega]4} =
Eigenvalues[\[CapitalLambda]u]
ff[DM_, \[Theta]_, \[Phi]_] = {Tr[\[CapitalLambda]u] +
Sqrt[\[Omega]1^2] +...
3
If it is not essential to have two different colors for the filling in the 3D plot, you can use a single Plot3D with the option Filling to get the 3D surface.
ClearAll[f1, f2, f3, polygon, arrow]
f1[x_] := 4.8 + Sin[x]
f2[x_] := 3 + (-8 + x) (1/13 + (0.01 + 0.0022*(-4 + x))*(5 + x))
f3[x_] := 0.01*(x + 5)^2
polygon[a_] := Graphics3D[{EdgeForm[{Thick, Blue}]...
2
animation jumps around
I assume you are taking about the y-axis shaking?
I think this is because you used zero for the plot range and log(0) does not play well in the code.
If you change the zero, to another non zero value then it stops shaking. I also added image padding for safe measure.
makeplot[k_] :=
ListLogLogPlot[svals[[k]], PlotRange -> {{0, ...
1
ClearAll[fa, fb, fc]
fa[x_] := -x/2 + 1
fb[x_] := Sqrt[1 - x^2]
fc[x_] := Sqrt[x - x^2/4];
You can generate the two red surfaces using a single ParametricPlot3D.
You can use the option RegionFunction instead of making the range of the second parameter depend on the value of the first parameter.
p1 = ParametricPlot3D[{{fb[y], x, y}, {- fb[y], x, y}}, {x, ...
1
Code
ClearAll[f1, f2, f3]
f1[x_] := 4.8 + Sin[x]
f2[x_] := 3 + (-8 + x) (1/13 + (0.01 + 0.0022*(-4 + x))*(5 + x))
f3[x_] := 0.01*(x + 5)^2
viewpoint = {-2.7, 1.6, 1.3};
plt1 = Plot3D[f3[x], {x, -5, 5}, {y, 2, 6},
Mesh -> 20, PlotStyle -> Opacity[0], MeshStyle -> Opacity[.8],
BoundaryStyle -> Directive[Thick, Gray], Lighting -> "...
2
I think you have to abandon ContourPlot, unless you want to transform the plot, which is possible. Here's one approach to get the contour lines using MeshFunctions:
ParametricPlot[{q, q*\[Phi]}, {q, 30, 100}, {\[Phi], Pi/300, Pi/200},
PlotPoints -> {500, 100}, MaxRecursion -> 0,
MeshFunctions -> {Function[{q, \[Phi]}, ArcTan[1/Sin[q*\[Phi]]]]},
...
1
Is this what you want ?
Manipulate[
Grid[{{Show[B1, B2, B3, B4[a], AxesStyle -> Thick, Boxed -> False,
AxesOrigin -> {0, 0, 0}, AxesLabel -> {x, y, z},
BoxRatios -> {1, 1, 1.3}], Show[t2, t3[a]]}},
ItemSize -> {{30, 30}}], {{a, 1}, -5, 5}]
(Please format the item size accordingly)
1
As your code for some reason crashes my mathematica kernel, I'll give you an example with a shorter, lighter code that can be easily adapted to your case:
plt1[a_] := Plot[Sin[a*x], {x, 0, 10}];
plt2[a_] := Plot[Cos[a*x], {x, 0, 10}];
Manipulate[
Grid[{{plt1[a], plt2[a]}}, ItemSize -> {{30, 30}}, Frame -> All,
FrameStyle -> Red], {{a, 1}, -5, ...
0
or try AspectRatio
Plot[E^x - 3 x, {x, -10, 10}, AspectRatio -> 1, PlotRange -> {Automatic, {-5, 10}}]
4
Use the option PlotRange:
Plot[E^x - 3 x, {x, -10, 10}, PlotRange -> {-5, 20}]
Alternatively,
Plot[E^x - 3 x, {x, -10, 10}, PlotRange -> {All, {-5, 20}}]
2
VectorPlot3D expects a function of Cartesian $(x,y,z)$ coordinates, but our functions use spherical coordinates. The solution is use CoordinateTransform. As an example,
CoordinateTransform["Cartesian" -> "Spherical", {x, y, z}]
(* {Sqrt[x^2 + y^2 + z^2], ArcTan[z, Sqrt[x^2 + y^2]], ArcTan[x, y]} *)
We recognize this result as $(r,\theta,\phi)$. ...
3
I'm trying to numerically solve a system of differential equations
describing two pendula connected to each other by a spring, and then
make an animation of their evolution in time
Here is something to get you started. You can do all this in Mathematica directly by solving the equations of motion and then use NDSolve to solve them and then do the ...
3
Silvia already gave a pretty rigorous derivation (compare this with the treatment by Hall and Wagon), so let me show how to plot the desired trajectory of the rolling polygon's corner. One could certainly modify the code I gave here for this, but I will instead adapt this solution I previously wrote in OpenGL to Mathematica:
With[{n = 4}, (* number of sides ...
0
If you look carefully, the variation is quite small. The plot range magnifies the effect of the round-off error. Compared to the number 1, the value seems fairly stable:
Plot[x Abs[Sqrt[0.0002^2 - x^2] - Sqrt[0.0001^2 - x^2]],
{x, 1000, 10000}, AxesOrigin -> {0, -1}]
Another way is to rationalize to a more numerically stable expression:
...
2
To plot the solution for a range of delc, make these changes to your code:
(1) Remove delc = 1; Leave delc undefined. It will be your parameter.
(2) Keep the ParametricDSolveValue command and its first argument, but change the other arguments to get
s = ParametricNDSolveValue[ ... ,
{1/2*(V11[t] + V22[t] - 2*V12[t])^(-1)}, {t, 0, 100}, delc];
...
2
You're just seeing numerical precision issues when working with machine numbers. Using higher precision will fix this. In order to use higher precision, you need to make sure the function to be plotted is exact, so the following should produce your expected output:
Plot[
x Abs[Sqrt[(2/10000)^2-x^2] - Sqrt[(1/10000)^2-x^2]],
{x,1000,10000},
...
8
If Off[PredictorFunction::mlincfttp] won't work, perhaps this:
(* holds up evaluation until x is numeric *)
ClearAll[applyN];
applyN[f_][x_?NumericQ] := f[x];
Plot[Evaluate@Through@(applyN /@ predictors)@x, {x, 0, 5}]
1
Try this:
MapThread[List, {{1, 2, 3}, {4, 5, 6}}]
(* {{1, 4}, {2, 5}, {3, 6}} *)
Have fun!
6
You could try with:
Show[Plot[#[x], {x, 0, 5}, PlotStyle -> RandomColor[]] & /@
predictors]
Or if you want the same colorscheme for each plot:
colors = {Blue, Red};
Show[Plot[predictors[[#]][x], {x, 0, 1}, PlotStyle -> colors[[#]]] & /@
Range@Length[predictors],PlotRange -> All]
2
The output of Solve (stored in sol) gives more than one solution (actually, there are 9 possible solutions):
sol = Solve[((I*(del + gamma*Abs[a1]^2) - k/2) a1 - (ke/2) a2 +
Sqrt[ke] s ==
0) && ((I*(del + gamma*Abs[a2]^2) - k/2) a2 - (ke/2) a1 +
Sqrt[ke] s == 0), {a1, a2}];
Length@%
9
You can plot them individually:
n = 1;
...
3
If you want to keep BoxRatios -> {1, 1, 1}, you can do
plt1 = Plot3D[10 - x^2 - y^2, {x, 0, 3.3}, {y, 0, 3.3},
PlotStyle -> Opacity[0.4], Mesh -> None,
PlotStyle -> Thickness[0.02], PlotRange -> {-1, 12},
AxesStyle -> Thick, Boxed -> False, AxesOrigin -> {0, 0, 0},
AxesLabel -> {x, y, z}];
pr = PlotRange[plt1];
...
Top 50 recent answers are included
