New answers tagged plotting
0
Clear["Global`*"]
font = 18;
DensityPlot[LogTQ + LogA, {LogTQ, -2, 1}, {LogA, 2, 6},
PlotLegends -> BarLegend[{"SunsetColors", {0, 7}},
LegendLabel ->
StringForm["``(``)", Subscript[log, 10], Subscript[P, C]]],
FrameTicksStyle -> Directive[font],
FrameLabel ->
(StringForm["``(``)", Subscript[...
0
Plot3D creates a plot using a function and two variables. Essentially, for Plot3D the function generates the z coordinate and you supply the x and y coordinates.
For ParametricPlot3D you supply 3 functions, where each function controls how that one axis is spanned. For example ParametricPlot3D[{Sin[x],Cos[x],x},{x,1,10}] the x axis is spanned using Sin[x], ...
3
Clear["Global`*"]
$Assumptions = a > 0 && ρ > 0;
z[ρ_, ϕ_, a_ : 1, nmax_ : 40] :=
50 + 200/Pi +
Sum[(ρ/a)^(2 n + 1) Sin[(2 n + 1) ϕ]/(2 n + 1), {n, 0, nmax}];
Plot3D[z[ρ, ϕ], {ρ, 0, 1}, {ϕ, 0, Pi},
WorkingPrecision -> 20,
PlotPoints -> 75,
MaxRecursion -> 5] // Quiet
If the number of terms is infinite
f = z[ρ,...
0
j1 = Table[{i, Sin[2^2 + i]}, {i, 0, 3, 0.05}];
k1 = ListLinePlot[j1]
Extract the line and convert it to 3D
y0 = 2;
line = Cases[k1, Line[pts_] :> Line[{#[[1]], y0, #[[2]]} & /@ pts],
Infinity][[1]];
s1 = Table[{i, j, Sin[j^2 + i]}, {i, 0, 3, 0.1}, {j, 0, 3, 0.1}];
Combine the line with the ListPointPlot3D
Show[
ListPointPlot3D[s1],
...
3
Here's my trial:
SeedRandom[2020];
data = Flatten[Table[{th, phi, RandomReal[100]}, {th, 0, 45, 3},
{phi, 0, 90 Degree, 2 Degree}], 1];
func = Interpolation[data];
{{rmin, rmax}, {phimin, phimax}} = func["Domain"];
radian = 32; dphi = 15 Degree;
Legended[ParametricPlot[r {Cos[phi], Sin[phi]}, {r, ...
0
Try this:
{yL, yR} = {-1, 1}; colorfunc = "Rainbow";
ParametricPlot[{x, x^2 + 6 y^(3/2)}, {x, -4, 4}, {y, yL, yR},
ColorFunction -> Function[{xaxis, yaxis, x, y}, ColorData[colorfunc][y]],
AspectRatio -> 1/GoldenRatio, PlotLegends -> BarLegend[{colorfunc, {yL, yR}}]]
Do notice this visualization won't work well on those functions ...
2
Here is just a draft that needs to be updated later since I am not so familar with Physic.
The code has some bugs :-(
Accoring to Kepler's Equation : $M=E-\mathrm{e}\sin E$
Clear["`*"];
a = 5;
b = 3;
c = Sqrt[a^2 - b^2];
e = c/a;
p = b^2/c;
ρ[θ_] = (p*e)/(1 + e*Cos[θ]);
fig = PolarPlot[ρ[θ], {θ, 0, 2 π}];
angle[M_] :=
2 (π + ArcTan[Sqrt[(1 + e)/...
9
28 characters:
Image@Array[(-1)^+## &, {8, 8}]
12 key strokes:
=chess board
1
This use of ImagePadding works on a simple example:
pTop = Plot[Sin[x], {x, 0, 2 Pi}, Frame -> True, Axes -> False,
ImagePadding -> {{All, All}, {0, All}}];
pMid = Plot[Sin[x], {x, 0, 2 Pi}, Frame -> True, Axes -> False,
ImagePadding -> {{All, All}, {0, 0}}];
pBot = Plot[Sin[x], {x, 0, 2 Pi}, Frame -> True,
ImagePadding -> ...
7
Try Image[Array[Mod[#+#2,2]&,{8,8}]]
1
Here is one way where you can control the size along x and y of each subfigure
plot1 = With[{XZ = 210, YZ = 70},
Plot[Sin[x], {x, -2 \[Pi], 2 \[Pi]}, Frame -> True,
ImageSize -> Automatic -> {XZ, YZ}, ImagePadding -> 80,
PlotStyle -> Red, Axes -> False]];
Grid[{{plot1}, {plot1}, {plot1}}, Spacings -> {-12, -12}]
and you ...
0
What do you mean by "plot the nonlinear difference equations"? I assume that you want, analogously to differential equations, to get a "velocity field". Towards this aim, you need to calculate the difference between x/y at n and n+1. Therefore you must not include the first x and y.
In addition, your code has several syntax errors, I ...
0
WolframAlpha["plot vector(1,1)+vector(2,3)", {{"Result", 1}, "Content"}]
To see the code behind you can take the first Part:
WolframAlpha["plot vector(1,1)+vector(2,3)", {{"Result", 1}, "Content"}][[1]]
To get the main graphics, use
WolframAlpha["plot vector(1,1)+vector(2,3)", {{"...
2
Here's an approach based on the fifth argument of Inset:
Graphics[
{
Inset[
Graphics[{},
Frame -> {{True, False}, {True, False}},
FrameTicksStyle -> (FontOpacity -> 0),
PlotRange -> {{0, 1}, {0, 1}}
],
{0, 0}, {0, 0}, {1, 1}, {{1, 0.5}, {0.5, 1}}
]
},
Frame -> {{True, False}, {True, False}},
PlotRange -> {{0, ...
4
Simply use Column:
pl = Plot[Sin[x], {x, 0, 2 Pi}];
Column[{pl, pl}, Frame -> All, Spacings -> 0]
4
https://resources.wolframcloud.com/FunctionRepository/resources/PlotGrid
ResourceFunction[
"PlotGrid"][{{Plot[Sin[x], {x, 0, 1}, Frame -> True,
FrameLabel -> {None, x}]}, {Plot[Cos[x], {x, 0, 1}, Frame -> True,
FrameLabel -> {None, x}]}}, FrameLabel -> {2 Pi t, None}]
0
Here is a first try. I do not claim that it is perfect, but it may serve as a starting point.:
skeweaxes[{{xmin_, xmax_}, {ymin_, ymax_}}, phi_] :=
Module[{nxti = 20, nyti = 20, xtlen = (ymax - ymin)/100,
ytlen = (xmax - xmin)/100},
rot0 = RotationTransform[phi]; rot1 = RotationTransform[-phi];
t0 = {rot0 /@ {{xmin, ymin}, {xmax, ymin}},
rot1 /...
2
Clear["`*"];
equ = Sqrt[t1^2 + u1^2] + Sqrt[t2^2 + u2^2] <= 1 &&
x == 2 t1 - u1 + 2 t2 + u2 && y == 2 u1 + t1 + 2 u2 - t2 &&
Element[{t1, u1, t2, u2}, Reals]
reg = ImplicitRegion[equ, {x, y, t1, u1, t2, u2}]
Resolve[Exists[{t1, u1, t2, u2}, {x, y, t1, u1, t2, u2} ∈
reg], Reals]
The result is
(y == -Sqrt[5] &...
2
The Moiré effect is exacerbated by the NormalsFunction. If you get rid the normals, the aliasing disappears around PlotPoints -> 800. With the normals, you probably have to go higher, doubling the plot points a few times perhaps. However, the plot below is already quite large and difficult to work with. It seems more sensible to me to reduce L to ...
2
There is so long post, but answer very short. At first step we define 3 function:
r0[u_?NumericQ, v0_?NumericQ] := 2 (1 + LambertW[(u^2 - v0^2)/E]);
z[u_?NumericQ, v0_?NumericQ] :=
NIntegrate[
Sqrt[2 (Exp[r/2] - v0^2)/(r*Exp[r/2] - 2*(Exp[r/2] - v0^2))], {r,
r0[0, v0], r0[u, v0]}, AccuracyGoal -> 2, PrecisionGoal -> 2]
wh[v0_?NumericQ] :=
...
1
Perhaps the logarithmic spiral is a suitable curve.
$$ a(\mathrm{e}^{bt}\cos t,\mathrm{e}^{bt}\sin t)$$
Solve[{({a*Exp[b*t] Cos[t], a*Exp[b*t] Sin[t]} /. t -> 0) == {300,
0}, ({a*Exp[b*t] Cos[t], a*Exp[b*t] Sin[t]} /.
t -> π/2) == {0, 480}}, {a, b}, Reals]
ParametricPlot[{a*Exp[b*t] Cos[t], a*Exp[b*t] Sin[t]} /. %, {t,
0, π/2}]
1
ω^2/c^2 ρ^2 + z^2=ρ^2 + z^2,so Sinc[ρ^2 + z^2] can be write by Sinc[t^2],t^2=ρ^2 + z^2,It means the graph is only depend on the distance from z-axis, so we can rotate Sinc by z-axis to get the plot.
RevolutionPlot3D[Sinc[t^2], {t, -25, 25}, ColorFunction -> "Rainbow",
Mesh -> None, PlotPoints -> 100, Boxed -> False,
ViewPoint -> {...
4
Your differential equation describes a vector field (velocity field) that you may display e.g. using SliceVectorPlot3D:
SliceVectorPlot3D[{2 x1^2, -2 x2^2,
3 x3^2}, "CenterPlanes", {x1, -.1, .1}, {x2, -.1, .1}, {x3, -.1, \
.1}, PlotTheme -> "Scientific"]
You see, that e.g. a particle coming from below from {0.1,-0.1,-0.1} with ...
1
You need to set ColorFunctionScaling to False, otherwise the x coordinate will be rescaled to lie between 0 and 1 before it is passed to the color function.
Plot[
{Cos[x], Sin[x]}, {x, 0, Pi},
ColorFunction -> Function[
{x, y},
If[
Abs[Cos[x]] > Abs[Sin[x]],
Red,
Blue
]
],
ColorFunctionScaling -> False
]
4
q := 1.6*10^-19;
me := 9.1*10^-31;(*Free electron rest mass in kg*)h :=
6.63*10^-34;(*Reduced Planck's constant in J.s*)kb :=
1.38*10^-23;(*Boltzmann constant in J/K*)
Jschottky[V_, T_] := (2 q*(2 \[Pi] me)^0.5 kb^1.5)/h^2*(0.3)^0.5*
Exp[-0.18/((kb*T)/q)] (Exp[(q*V)/(kb*T)] - 1);
p1 = LogPlot[Abs[Jschottky[V, 77]], {V, -0.5, 0.5}, PlotRange -> All,
...
2
you can also use the buiilt-in (but undocumented) chart element function System`BarFunctionDump`TextureBar with your custom textures:
ClearAll[texture]
texture[ms_: {Black, White}, m_: 100] := Texture @
RegionPlot[True, {x, 0, 1}, {y, 0, 1},
MeshFunctions -> {# - #2 &}, Mesh -> m, MeshStyle -> None,
MeshShading -> ms, Frame -> ...
3
In HatchFilling[θ, r, d], the $r$ and $d-r$ is the wide of the filling color and the blank. Here we using $r=10$ and $d-r=4$
Since I don't know how to handle the Light color when we using HatchFilling, I had to set Opacity by hand.
We use Directive to combine the options of HatchFilling and Opacity and color.
fill = HatchFilling[Pi/4, 10, 10 + 4];
BarChart[{{...
3
You can do it as follows (using the hack from here Two-color HatchFilling):
ClearAll[wthack]
wthack[clr_:Blue][{d___,h_HatchFilling}]:=PatternFilling[ColorReplace[Graphics[{d,h,Rectangle[]}],White->clr],ImageScaled[1]]
BarChart[
{{Style[0.408808,Black],
Style[0.0944349,Purple],
Style[0.132875,Blue],
Style[0.203982,Green],
Style[0.1599,Red]},{
Style[...
0
Since the question has already be answered, let me present a variation of cvgmt's answer which might be more readable:
With[{plane = InfinitePlane[{{1/2, 0, 0}, {1/2, 1, 0}, {1/2, 0, 1}}],
sphere = Sphere[{5, 0, 0}, 10],
xAxis = InfiniteLine[{{0, 0, 0}, {1, 0, 0}}],
yAxis = InfiniteLine[{{0, 0, 0}, {0, 1, 0}}],
zAxis = InfiniteLine[{{...
3
Based on @Szabolcs, It seems by increasing the size and change the resolution,
Magnify[
Rasterize[
Graphics[
{Thickness[0],Line[#] & /@ ({po[[1 ;; -2]], po[[2 ;;]]}\[Transpose])},
ImageSize -> 10000],
ImageResolution -> 100], 0.1]
we can find desire fine structure,
I suggest Opacity also may be useful in some case,
...
11
tet = Tetrahedron[{{-1, -1, -1}, {1, 1, -1}, {-1, 1, 1}, {1, -1, 1}}];
Graphics3D[{tet}, Axes -> True]
We can use RegionPlot3D with the options Mesh and MeshShading to subdivide tet into 8 tetrahedra and style the faces differently:
SeedRandom[12]
RegionPlot3D[tet,
PlotPoints -> 90, BaseStyle -> Opacity[.9],
Mesh -> 1,
MeshShading -> ...
5
Not really a mathematica problem but here is something to get you going in the Wolfram Language.
eqn = x''[t] + (2 π 100)^2 x[t] == f[t];
ic = {x'[0] == 0, x[0] == 0};
f[t_] := Sin[110 2 π t];
sol = NDSolve[Join[{eqn}, ic], {x}, {t, 0, 0.2}];
Plot[Evaluate[x[t] /. First[sol]], {t, 0, 0.2}]
Here I have made an oscillator with a natural frequency of 100 Hz ...
3
Clear["Global`*"]
f[ℓ0_Integer?NonNegative] := f[ℓ0] =
Module[
{ne = 2 ℓ0 + 2, vars, cons, mtablep, M, ene},
vars = Array[Symbol["x$" <> ToString[#]] &, ne];
cons = Apply[And, Thread[0 <= vars <= π/2]];
mtablep = Riffle[Range[0, -ℓ0, -1], Range[ℓ0]];
M[ℓ_, p1_, p2_, pp1_, pp2_] :=
If[mtablep[[p1]] + ...
2
Clear["Global`*"]
You need to reposition the labels
MyLegendre = Table[LegendreP[v, x], {v, 0, 4}];
Plot[MyLegendre, {x, -1, 1},
Frame -> True,
PlotLabels ->
Placed[{"v=0", "v=1", "v=2", "v=3", "v=4"},
{{Scaled[0.5], Above}, {Scaled[0.385], Above}}]]
2
You can design a ColorFunction so that a standard color function is used in most cases, except for some values. Here is a possiblity.
Case 1: The standard "rainbow" function
h = Table[Sin[j^2 + i], {i, 0, Pi, Pi/4}, {j, 0, Pi, Pi/4}];
l1 = ListDensityPlot[h, ColorFunction -> ColorData["Rainbow"],
Axes -> False, Background -> ...
0
Let us start with reading the question.
The given function is
(x^3 y^5 E^(-2*z*n))/(x^2 + y^2)
this is dependent on x, y, z and n. So the function has to reflect this four parameters:
g[x_,y_,z_,n_]:=(x^3 y^5 E^(-2*z*n))/(x^2 + y^2)
The polynomial in the denominator has no zeros on the Reals. The multinomial in the nominator has a coefficient functions ...
2
You may try the option"RegionFunction" of ListDensityPlot.
Here is an example:
dat = Table[t1 = RandomReal[{-1, 1}]; t2 = RandomReal[{-1, 1}];
If[t1^2 + t2^2 < .5, Nothing[], {t1, t2, t1^2 + t2^2}], 1000];
ListDensityPlot[dat, RegionFunction -> ((#1^2 + #2^2 >= .6) &)]
But note, RegionFunction together with ListDensity plot is a ...
4
Clear["Global`*"]
g[x_, y_, z_, n_] := (x^3 y^5 Exp[-2*z*n])/(x^2 + y^2)
Manipulate[
Module[{x, func, t, var},
If[plt == 1,
var = "z"; func = g @@ Rationalize[{x, y, t, n}],
var = "y"; func = g @@ Rationalize[{x, t, z, n}]];
Plot3D[func, {x, -10, 10}, {t, -10, 10},
WorkingPrecision -> 20,
MaxRecursion -> ...
3
Maybe use the SliceContourPlot3D to display the level sets of g[x,y,z,n] is easy and faster.
Clear["`*"];
g[x_, y_, z_, n_] := (x^3 y^5 E^(-2*z*n))/(x^2 + y^2);
Manipulate[
SliceContourPlot3D[
g[x, y, z, n], {"CenterPlanes"}, {x, -10, 10}, {y, -10,
10}, {z, -10, 10}, Contours -> 50, PerformanceGoal -> "Quality",
...
2
Using the Mesh option, as indicated in the link only works fur cuts parallel to a coordinate plane. For arbitray intersections:
You can get the cut of your two regions by: "RegionIntersection[plane, sphere]". However, what you get is not a graphical primitive. So, you can not simply use it in Graphics3D. To turn it into something that Graphics3D ...
2
This is also possible in v11.0+ with ImageMesh and Rasterize. The RasterSize ends up affecting mesh quality here:
RegionBoundary@ImageMesh@ColorNegate@Rasterize["любо",RasterSize->400]
You could also just get the edge by using a FillingTransform to ignore the interior of shapes:
RegionBoundary@ImageMesh@FillingTransform@ColorNegate@Rasterize[&...
4
We use the implicit exprssion of plane. The normal of plane is Cross[b-a,c-a]
({x, y, z} - a).Cross[b - a, c - a]==0
And we also use the implicit expression of sphere,here {5,0,0} is the sphere center and 10 is radius.
Norm[{x, y, z} - {5, 0, 0}] - 10==0
Norm[{x, y, z} - {5, 0, 0}] - 10 as MeshFunction
x = InfiniteLine[{{0, 0, 0}, {1, 0, 0}}];
y = ...
2
An alternative approach to remove the legend: Take the first Part of Plot output:
plot = Plot[Sin[x] - 1, {x, -3, 3}, PlotRange -> {-3, 1},
PlotTheme -> "Detailed", PlotStyle -> Automatic,
AxesLabel -> Automatic, Frame -> True,
FrameLabel -> {Style["x", FontSize -> 22, Bold], Style["V(x)", FontSize -...
0
Indeed, as CA Trevillian stated, this whole code should work, and it does. An example is
fA[r_, θ_, ϕ_] = ((4/3 r^0 )*
LegendreP[0, 0, Cos[θ]]) + ((-r^1 )*
LegendreP[1, 0, Cos[θ]]) + ((1/6 r^2 )*
LegendreP[2, 0, Cos[θ]]);
fB[r_, θ_, ϕ_] = ((8/3 r^(-(0 + 1)))*
LegendreP[0, 0, Cos[θ]]) + ((-8 r^(-(1 + 1)))*
LegendreP[1, 0, Cos[θ]]) + ((...
2
The formula that you provided does not appear to correspond to the diffraction figures that you provided. I have provided an interactive plot for the formula that you provided.
Clear["Global`*"]
Manipulate[
Module[{plt},
d[λ_, f_, R0_, α_, ΔT_] :=
1.22 λ f/(Quantity[R0, "Millimeter"] Sqrt[1 + 2 α ΔT]);
Switch[calc,
1, α = 8.6*...
5
Use RealAbs instead of Abs since Abs is a Complex function.
And the Sqrt is also a Complex function, sometimes we use Surd instead of Sqrt or Power
if we assume x is a real numbers,we can use ComplexExpand to observe the expression of Abs[Sqrt[x - 1] + 5]
Abs[Sqrt[x - 1] + 5] // ComplexExpand
(* Sqrt[(5 + ((-1 + x)^2)^(1/4) Cos[1/2 Arg[-1 + x]])^2 +
...
5
The problem you are running into is that the ListPlot is cropping the plot-region in an unlucky way. Put PlotRange->All as final option into the ListPlot call and you should be fine.
You could have found this issue yourself by inspecting the plots separately.
4
GraphComputation`$GraphThemes // Column
themestyles = "GraphStyle" /. GraphComputation`$GraphThemes
{"BackgroundBlack", "BackgroundBlue", "BackgroundGold",
"BackgroundGreen", "BasicBlack", "BasicBlue", "BasicGold",
"BasicGreen", "DiagramBlack", "...
2
You can look at the contextual menu (as you enter the option PlotTheme -> ), in the documentation for PlotTheme, and in the documentation for LayeredGraphPlot
Manipulate[
LayeredGraphPlot[{"John" -> "plants", "lion" -> "John", "tiger" -> "John",
"tiger" -> "deer&...
0
DiscretePlot3D is not appropriate for what you want to do, but with some work ListPointPlot3D can do it. First, we have to put your data in a form ListPointPlot3D can understand.
Module[{given, data},
given =
{{0.25, 0.25, 0.25, 0.5, 0.5, 0.5, 1, 1, 1},
{0.377821, 0.349883, 0.340228, 0.34147, 0.32781, 0.320258, 0.319791, 0.307732, 0.30451},
{...
Top 50 recent answers are included
