New answers tagged plotting
2
Maybe this?:
Plot[{Sin[x], Sin[-x]} + Cos[x]/2, {x, -Pi - 0.01, 3 Pi + 0.01},
AspectRatio -> Automatic, Mesh -> {{0}}, MeshFunctions -> {Sin[#] &},
MeshStyle ->
Directive[PointSize[Medium], RGBColor[
0.4907806591595267, 0.4396552977670637, 0.6375127068715876]],
PlotStyle -> RGBColor[
0.9849415764566248, 0.46166225896480656`, ...
2
Clear["Global`*"]
Slopetriangle1 = {{1.8, -250}, {1.8, -250 + 59 +
59}, {-0.2, -250}, {1.8, -250}}; Slopetriangle2 = {{1.8, -250}, {1.8, \
-250 + 59 + 59 + 59}, {-0.2, -250}, {1.8, -250}};
The easiest solution is to combine into a single ListPlot
ListPlot[{Slopetriangle1, Slopetriangle2},
PlotStyle -> {Black, {Black, Dashing[{0.05, 0.01}]...
1
One way to do it is to wrap the Legended function around Show. Here is an example:
data = Table[{x, Sin[x]}, {x, 0, 2 \[Pi], \[Pi]/10}];
lgnd = Framed[
Column[{
PointLegend[{Red}, {"data"}],
LineLegend[{Blue}, {"fit"}]}], RoundingRadius -> 20,
Background -> LightBlue];
Legended[
Show[ListPlot[data, PlotStyle -> ...
2
You can combine two plots by using Show:
randGen = RandomReal[{0, 1}, {10, 100}];
p1 = Plot[1 - x/10, {x, 0, 10}, Frame -> True, FrameLabel -> {"x", "y"}];
p2 = BoxWhiskerChart[randGen, ChartStyle -> "Pastel",
FrameLabel -> {"", "x"}];
Show[p1, p2]
Note that I have scaled the curve and ...
2
You can provide the color of the point in the PlotStyle:
data = RandomReal[1, {200, 3}];
ListPolarPlot[{#} & /@ data[[All, 1 ;; 2]], PolarAxes -> True,
PolarTicks -> {"Degrees", Automatic},
PolarGridLines -> True,
PlotStyle -> ColorData["Rainbow"] /@ data[[All, 3]],
PlotLegends -> BarLegend["...
5
SliceContourPlot3D[ x^2 + y^2 + z^2,
{x == 0, y == 0},
{x, y, z} ∈ Ball[],
Contours -> {{1}},
ContourShading -> Opacity[.5, Red],
BoundaryStyle -> {Thick, Black},
RegionFunction -> (#3 >= 0 &)]
3
One more hackneyed way repurposing some old code that had very short cylinders.
Graphics3D[
{{Orange, Opacity[0.1], EdgeForm[Thick],
Cylinder[{{1, 1, 0.99}, {1, 1, 1}}, 1]},
{Blue , Opacity[0.1], EdgeForm[Thick],
Cylinder[{{0.99, 1, 1}, {1, 1, 1}}, 1]}},
Axes -> True,
AxesLabel -> {x, y, z},
ImageSize -> 450,
PlotRange -> {{0, ...
6
Reply to the Comment
Given a fixed point {x0,y0,z0} and a parametric space curve h[u_]:={10 Cos[u], 0, 10 Sin[u]}, we can construct lines from {x0,y0,z0} to h[u] by {x0,y0,z0}+ t*(h[u]-{x0,y0,z0}), here 0<=t<=1, that is the way to construct such surface.
Original
f[u_, t_] := {0, 0, 1} + t*{10 Cos[u], 0, -10 Sin[u]};
g[u_, t_] := {0, 0, 1} + t*{0, 10 ...
2
I'm gonna be honest here, I didn't even try to understand your code.
It seems that it produces a lot of unnessecary duplicate data I think.
I implemented a Grid from scratch which can only generate a non-rotated grid:
TriAngle[{x_,y_},leftMost_,topMost_]:={
Line[{{x,y},{x,y}+{Sin[Pi],Cos[Pi]}}],
Line[{{x,y},{x,y}+{Sin[Pi+2/3Pi],Cos[Pi+2/3Pi]}}],
Line[{{x,y},{...
1
Just to explore some of the range of possibilities from @Lukas_Lang's comment:
plot = DensityPlot[Tan[x - y], {x, 0, 2}, {y, 0, 5},
Mesh -> Automatic, MeshFunctions -> {#3 &}, FrameLabel -> {x, y},
PlotLegends -> Automatic, ImageSize -> 250,
ScalingFunctions -> #] & /@ {
{None, None, None},
{"Reverse", ...
1
And the solution is: use HurwitzZeta instead of Zeta.
b[s_, v_] := If[s == 0, 1, -s*HurwitzZeta[1 - s, v]];
V := Table[FunctionExpand[FullSimplify[b[n, x]]], {n, 1, 6}];
W := Table[BernoulliB[n, x], {n, 1, 6}];
Grid[{V, W}, Frame -> All]
oh well ...
0
Perhaps a partial answer: According to Mathworld, Eq. 9, the comparison should be:
bs = Table[-BernoulliB[n + 1, x]/(n + 1), {n, 1, 6}]
and
zs = Table[Zeta[-n, x], {n, 1, 6}]
which appear to be the same when x>0:
Plot[bs, {x, 0, 3/2}]
and
Plot[zs, {x, 0, 3/2}]
but not when x < 0
Plot[bs, {x, -1, 0}]
and
Plot[zs, {x, -1, 0}]
but note that:
With[{...
5
We can have an attraction basin coarse image as follows
r = 1;
G = {{3, 3, 3, 1}, {2.5, 2.5, 2.5, 0.5}, {2.5, 2.5, 2.5, 0.5}, {3.5,
3.5, 3.5, 1.5}};
u1[x_, y_, z_] := G[[1, 1]]*x + G[[1, 2]]*y + G[[1, 3]]*z + G[[1, 4]]*(1 - x - y - z);
u2[x_, y_, z_] := G[[2, 1]]*x + G[[2, 2]]*y + G[[2, 3]]*z + G[[2, 4]]*(1 - x - y - z);
u3[x_, y_, z_] := G[[3, 1]]*x + G[[3,...
5
I can recommend ParametricNDSolve[] to compute trajectories and ParametricPlot3D[] for visualization, for example,
Clear[f, g, h, p, r, l, g, jac, u1, u2, u3, u4]
r = 1;
G = {{3, 3, 3, 1}, {2.5, 2.5, 2.5, 0.5}, {2.5, 2.5, 2.5, 0.5}, {3.5,
3.5, 3.5, 1.5}};
u1[x_, y_, z_] =
G[[1, 1]]*x + G[[1, 2]]*y + G[[1, 3]]*z + G[[1, 4]]*(1 - x - y - z);
u2[x_, ...
5
Update to fix boundary and initial condition inconsistency
Your "MaxCellMeasure" is much more refined than it needs to be. Furthermore, you will note that the initial condition and the DirichletCondition are inconsistent. This causes the DirichletCondition to be ignored. One way to remove this inconsistency is to rapidly ramp up the ...
2
In versions 12.2+, you can use PointValuePlot which allows multiple parameters that can be associated with color/size/shape/... of 2D points:
SeedRandom[1];
data = RandomReal[{0, 1}, {8, 6}];
PointValuePlot[data[[All, ;; 2]] ->
MapAt[ToString[Round[#, .1]] &, data[[All, 3 ;;]], {All, {1, -1}}],
{2 -> "Color", 3 -> "Size&...
4
As far as I am aware, there is no dedicated built-in function for this task, which I find rather strange given how often this is needed. (Unless something that I am not aware of was added recently.) Therefore, I usually implement this from scratch.
Let us generate some example data:
data = RandomReal[{-1, 1}, {20, 3}];
There actually is a similar function, ...
3
Roman gave the solution:
Plot[1-(1-x)^Floor[2/x],{x,0,1/20}, PlotPoints -> 10^4]
yields
1
Show[] uses AspectRatio and ImageSize from the first listed ParametricPlot.
I also specified the AspectRatio.
s = NDSolve[{Derivative[2][x][t] == x[t]^2, x[0] == 1,
Derivative[1][x][0] == 0}, x, {t, 0, 2}];
DynamicModule[{tr = 1},
Column[
{ti = 1,
tf = 2,
Show[
ParametricPlot[
Evaluate[{t, x[t]} /. s], {t, ti, tf},
PlotStyle -> ...
3
The two options I see are to either build your own gradient function or to use Interpolation.
Using a custom function:
gradient[mat_, xstep_ : 1,
ystep_ :
1] := {Join[{mat[[2]] - mat[[1]]},
Differences[mat, {1, 0}, 2]/2, {mat[[-1]] - mat[[-2]]}]/xstep,
Join[{mat[[All, 2]] - mat[[All, 1]]},
Differences[mat, {0, 1}, 2]\[Transpose]/
2,...
2
The reason for the different discrete values is that you're using the same sample rate (Nmax) to sample two sine functions with different frequencies. The first sine function has frequency = n0/(2 Nmax) = .25. The second sine function has a lower frequency = n0/(2(Nmax+1)) = 0.248062.
Let's show the difference in the sine waves by plotting a few periods of ...
2
Just add BoundaryStyle -> {{1, 2} -> {Thick, Red}} to your ContourPlot3D:
Warning: this took close to 5 minutes to compute!
3
One way is as below.
reg1 = ImplicitRegion[(2 +
a γ)^2/(2 (-4 + γ^2)^2) == -(((-1 +
r) (-8 + (3 + r) γ^2 +
a γ (-6 + (2 +
r) γ^2))^2)/(4 (-2 + γ^2)^2 (-4 + (1 +
r) γ^2)^2)), {{γ, 0, 1}, {a, 0, 1}, {r,
0.4, 1}}];
reg2 = ImplicitRegion[(-2 + a (-1 + r) γ +
r γ^2)^2/(4 (-2 + γ^2)...
1
Clear["Global`*"]
tmax = 100;
n[t_] := S[t] + P[t]
For "different inputs" use ParametricNDSolveValue
SP = ParametricNDSolveValue[{S'[t] == (-b/n[t])*S[t]*P[t],
P'[t] == (b/n[t])*S[t]*P[t], S[0] == 99/100, P[0] == 1/100},
{S, P}, {t, 0, tmax}, {b}];
Use Manipulate to see the effects of varying the parameter
Manipulate[
Plot[
...
3
All the legend-related questions can be answered by looking at examples in the PlotLegends doc page. Generally, it is a good idea to look through the examples in the relevant documentation pages.
You can do something like this:
{f1, f2} = SP;
st = Style[#, 15, Black] &;
Plot[{f1[t], f2[t], f1[t] + f2[t], 0},
{t, 0, tmax},
PlotStyle -> {Blue, Red, ...
1
I like to use Epilog to insert graphics primitives exactly as I like them. For example:
Plot[{Through[SP[t]], Total@Through[SP[t]]} // Evaluate, {t, 0, tmax},
PlotStyle -> {Blue, Red, Dashed}, Frame -> True,
FrameLabel -> {Style[Time, Black, FontSize -> 15],
Style[Density, Black, FontSize -> 15]},
Epilog -> {Text["A(t)", {...
1
The answer to part one of your question is that you must explicitly pass in the x, y, or z component to the ColorFunctionas shown below:
Plot3D[Abs[E^(I (t/2 + x)) (Coth[t + x])], {x, -2, 2}, {t, -2, 2},
ColorFunction -> Function[{x, y, z}, #[z]],
PlotLegends -> Automatic, PlotPoints -> 15,
PlotRange -> All] & /@ {Hue, JetCM}
As ...
2
Clear["Global`*"]
In response to your comment, "Also, if there is a way to use Filling with a break specified by the independent variable (if x < 0.5, fill between f1 and f2, otherwise fill between f2 and f3), some sort of piecewise, that would also help me a lot. But I can only find an option for Filling to specify the level (y coordinate)...
1
You might consider just generating a table of points. The downside is that the spacing of the points might not be as optimal as what you get with harvesting the points from ParametricPlot.
Using your example with 500 points:
k[w_] := Exp[(-I)*w]/(1 + I*w);
p = Table[{w, Re[k[w]], Im[k[w]]}, {w, -Pi, 0, Pi/500}];
p = Select[p, 0 <= #[[3]] <= 1.1 &&...
1
You can use AudioData to get the data from an Audio object.
2
In this case, I would do as follows.
Here is your plot:
k[w_] := Exp[(-I)*w]/(1 + I*w);
p = ParametricPlot[{Re[k[w]], Im[k[w]]}, {w, -Pi, 0},
PlotRange -> {{-0.7, 2.1}, {0, 1.1}}];
This is the position of the line you are looking for in the form of a list:
Position[p, Line] // Flatten
(* {1, 1, 1, 3, 1, 2, 0} *)
One only needs to replace the ...
1
Yes, there are some differences. For example, if we set f[u_]:=-u/2 and u in the interval {u,-Pi/2,Pi}, then the three pictures below are different.
surface[u_, v_] := {Cos[v] Cos[u], Cos[v] Sin[u], Sin[v]};
f[u_] := -u/2;
a = ParametricPlot3D[surface[u, v], {u, -Pi/2, Pi}, {v, -f[u], f[u]},
PlotRange -> All];
b = ParametricPlot3D[surface[u, v], {u, -...
2
I rather suspect there are more numerically stable methods one can
use. And possibly there are guidelines for how to select that
tolerance.
A possible solution is to use optimal SVD truncation for Prony/Hankel matrix.
Matan Gavish, David L. Donoho, The Optimal Hard Threshold for Singular Values is 4/sqrt(3)
With SeedRandom[1] approximate (see also a more ...
2
Here is an approach to analyzing the signal using Prony's method. This is applicable to data from evenly spaced measurements, when the signal is a sum of complex exponentials. The code is taken from an MSE thread; substantially similar is also in a Wolfram Community thread.
We repeat the code used to obtain signal data.
v = 50;
x = 2;
tstart = 0;
tend = 0.45;...
2
Not a bug. I don't go into deep of your uncommented code. The definition of Piecewise at zsr== 0.996987 and the WorkingPrecision option and {zsr, 0, 2} help:
ParametricPlot[{tAQ[zsr, 1], Piecewise[{{SA[zsr, 1], zsr <= 0.996987}, {SA[0.996987, 1],
zsr > 0.996987}}]}, {zsr, 0, 2}, AspectRatio -> 3/4, AxesStyle -> Directive[Black, 24],
...
3
I did multiple changes to your code, which I summarize below, roughly from most important to least important.
For all instances of NIntegrate I switched to Method->{"LocalAdaptive"}. That is to say whenever there is something like NIntegrate[..., Method -> {GlobalAdaptive, MaxErrorIncreases -> 10000}]], I used NIntegrate[..., Method -&...
2
Use NumberForm:
LabelingFunction -> (Placed[NumberForm[Last@#1, 2], Above] &)
1
As I understand, you want to colour each edge based on its position in the edge list. With IGraph/M,
Needs["IGraphM`"]
g = RandomGraph[{10, 20}]
Graph[g, GraphStyle -> "ThickEdge"] //
IGEdgeMap[ColorData["Rainbow"], EdgeStyle -> Rescale@*Range@*EdgeCount]
3
ClearAll[edgeColorList, legends]
edgeColorList[cf_ : Automatic][g_Graph] :=
Switch[cf,
Automatic, ColorData[97] /@ Range[EdgeCount[g]],
_String, ColorData[{cf, {1, EdgeCount@g}}] /@ Range[EdgeCount[g]],
_Integer, ColorData[cf] /@ Range[EdgeCount[g]],
_, cf];
legends[cf_ : Automatic][g_Graph] := Grid[Transpose @
Prepend[{ "...
0
Finally, just adding Evaluate does it
ParametricPlot[Evaluate[{ s[t], i[t]} /. sol], {t, 0, 2}]
Still, I would like to understand why that is required with ParametricPlot but not with Plot
4
@Bed_Izd really had this, but I thought to post a complete answer before the end of the day.
Happy to withdrawal it if @Bed_Izd wants to post.
Mobility210419ZcI = {{10, 14.15}, {10, 16.36}, {10, 17.99}, {40,
14.86}, {40, 19.65}, {40, 17.22}, {100, 20.28}, {100,
19.16}, {100, 19.18}, {150, 21.86}, {150, 20.7}, {150,
22.75}, {200, 22.06}, {200, ...
5
I am not sure exactly what you want but one may proceed as follows. I repeat your start.
v = 50;
x = 2;
tstart = 0;
tend = 0.45;
num = 256;
tstep = (tend - tstart)/(num - 1) // N;
sig = N[Table[{t, (Exp[-(I*2*Pi*v + Pi*x) (t)] +
Random[NormalDistribution[0, .06]] +
I Random[NormalDistribution[0, .06]])}, {t, tstart, tend,
tstep}]];
...
2
Clear["Global`*"]
α1[l_, b_, a_, θ_, M_,
r_] := -(a^2*(1 + l)*(2*M + 2*r + b) +
r*(2*r^2 + 3*b*r + b^2 - 2*M*(3*r + b)))/((a*
Sqrt[1 + l]*(2*M - 2*r - b))*Sin[θ])
β1[l_, b_, a_, θ_, M_, r_] :=
Sqrt[(r^2*(8*a^2*(1 + l)*
M*(2*r + b) - (2*r^2 + 3*b*r + b^2 - 2*M*(3*r + b))^2)/((1 + l)*
a^2*(2*M - 2*r - b)^2)) +
...
1
It does look like "an obscure bug".
A work-around is to construct the polar axes/ticks primitives from scratch. The function polarAxes below creates angular and radial axes/ticks/gridlines given a radial range (radius), angular axis origin (startingangle) and specs for angular/radial ticks/gridlines (each can be specified as an integer or a list). ...
2
tf = TransferFunctionModel[{{1/(s + 1)}}, s];
freqs = {{π, 2 π}};
BodePlot[tf, {.01, 100}, Mesh -> Table[freqs, 2],
MeshStyle -> Directive[PointSize[Medium], Red]]
0
Perhaps this will work for you.
First let's find where sigma>0
P=1;w=1;x=2;nl=2;S=2;sigmaL=0;sigmaH=1;n=6;
Sigmai=Subdivide[sigmaL,sigmaH,10];g=(P*(S-s))/(w*x*nl);
sigma=(-(1-sigmaL*g)-(Sqrt[((1-(sigmaL*g))^2)-(4*g)]/(2*g)));
Reduce[sigma>0,s]
which returns
2<s<2*(2+Sqrt[2])
so that tells us what we need to tell Plot
L=(sigma*P*(S-s))/(w*x*nl);...
0
Consider:
PolarTicks -> {Drop[Table[i, {i, 0, 2 Pi, Pi/6}], -1], None}
This specifies that you do not want an r-axis with radial ticks. Change "None" e.g. to "Automatic":
eps = 1
RegionPlot[
Sin[5 x] + Cos[5 y] > 0.2 &&
Sqrt[x^2 + y^2] < \[Pi]/2, {x, -\[Pi]/2 - eps, \[Pi]/2 +
eps}, {y, -\[Pi]/2 - eps, \[Pi]/2 + ...
6
plot = Plot[{Exp[-x^2], ConditionalExpression[Exp[-x^2], .6 <= x <= 1]}, {x, 0, 1},
PlotRange -> {0, 1},
PlotStyle -> Blue,
Filling -> {2 -> Bottom},
GridLines -> {{0.6}, {0.7}}]
Area @ BoundaryDiscretizeGraphics @ plot
0.211665
Alternatively,
Integrate[Exp[-x^2], {x, .6, 1}]
0.211671
6
Update: For version older than v 12.1 HatchFilling is not available. You can construct filling using RegionPlot with the options Mesh + MeshStyle (as in this answer) and use it as Epilog in Plot:
Plot[{Sin[x], 0.3}, {x, 0, 2 π},
Epilog -> First[RegionPlot[0 < y <= .3, {x, 0, 2 Pi}, {y, -1, 1}, Mesh -> 20,
MeshFunctions -> {#1 - 2 #2 &...
0
Very simple solution and using Bode plot
fr = ReplaceAll[1/(s + 1), s -> Sqrt[-1] \[Omega]];
LogLinearPlot[20 Log10[Abs[fr]], {\[Omega], 0.001, 100},
PlotRange -> All];
LogLinearPlot[Arg[fr], {\[Omega], 0.001, 100}, PlotRange -> Full];
\[Omega] = 2 Pi;
N[Abs[fr]];
N[Arg[fr]];
Top 50 recent answers are included
