11
An alternative method for visualization and faster than ContourPlot with PlotPoints -> 1000 for nearly the same high quality in this case:
Needs@"NDSolve`FEM`"
bmesh = ToBoundaryMesh[
ImplicitRegion[
w[x, y] < 0 && 0.8 < x < 1.0 && 0.8 < y < 1.0, {x, y}],
"MaxBoundaryCellMeasure" -> 0.01];
...
8
ListPlot[
{Thread[{x, y}], Thread[{x, y^2}],
Thread[{x, y^3}], Thread[{x, y^4}]},
Filling -> {
1 -> {{2}, Opacity[0.3, Red]},
3 -> {{4}, Opacity[0.3, Blue]}
},
PlotStyle -> {Red, Red, Blue, Blue}, Joined -> True,
PlotRange -> {1, 3}
]
7
Mesh + MeshStyle
You can use the options Mesh and MeshStyle:
GroupDelay = 0.00012 Erfc[w/10000/Pi];
LogLinearPlot[GroupDelay /. w -> 2 π f, {f, 10, 3000},
PlotRange -> {{10, 3000}, All},
Mesh -> {{2000}},
MeshStyle -> Directive[Red, PointSize[Large]]]
Epilog
To use Epilog we need to log-transform the horizontal coordinate of the point we ...
7
You can use the option ScalingFunctions! They're easy to use but a bit tricky to understand. I'll be honest: I don't know what the second function it asks for does, but the documentation says to use the inverse function of the first one, so that's what I'll do. I'd love for someone to explain it.
So, I used a piecewise function that sends the interval $[0,0....
6
tri = AASTriangle[Pi/2, Pi/4, 1];
srd = SignedRegionDistance[tri];
We can use SignedRegionDistance with ContourPlot or with RegionPlot (this would be very slow):
ContourPlot[srd[{x, y}], {x, -.2, 1}, {y, -.2, 1},
Contours -> {.1, .02},
ContourShading -> {None, Yellow},
ImagePadding -> 10, Frame -> False, ImageSize -> Large]
...
6
If you use the code in my answer and convert the result to a MeshRegion using DiscretizeGraphics, then the result exports to OBJ at a reasonable resolution. Here's what it looks like on 3dviewer.net:
You can also see an rotatable and colored version (after conversion to X3D) in this Observable notebook. I added the color by manually editing the X3D file.
A ...
5
With your definitions of rolls and sums, you can find the parameters for the corresponding normal distribution by calculating the mean and standard deviation of sums directly, using Mean and StandardDeviation, or more generally using FindDistributionParameters:
pdf = PDF[NormalDistribution[mu, sigma] /.
FindDistributionParameters[sums, NormalDistribution[...
5
a = 1; c = 1;
b = -1; d = 1;
p = 1; q = -1;
f1 = (Exp[-2 r a] p)/(2 r c) + (Exp[-2 r b] p)/(2 r d);
f2 = (Exp[-2 r a] q)/(2 r c) + (Exp[-2 r b] q)/(2 r d);
a = 1; c = 1;
b = -1; d = 1;
p = 1; q = -1;
f1 = (Exp[-2 r a] p)/(2 r c) + (Exp[-2 r b] p)/(2 r d);
f2 = (Exp[-2 r a] q)/(2 r c) + (Exp[-2 r b] q)/(2 r d);
Plot[{f1, f2}, {r, -2, 2}, PlotRange -> ...
5
Revolve three parametric curves. {x, f[x]} , {0, y} and {4, y}
SetOptions[RevolutionPlot3D, Mesh -> False];
f[x_] := Sqrt[E^-x (1 + E^x)^2];
a = RevolutionPlot3D[{x, f[x]}, {x, 0, 4},
RevolutionAxis -> {1, 0, 0}, PlotStyle -> Red];
b = RevolutionPlot3D[{0, y}, {y, 0, f[0]},
RevolutionAxis -> {1, 0, 0}, PlotStyle -> Yellow];
c = ...
4
Updated
pts = {{0, 0}, {2, 0}, {0, 4}};
in = {.7, 1};
smallpts = Mean[{#, in}] & /@ pts;
Graphics[{Orange, EdgeForm[{JoinForm["Round"], Thickness[0.035]}],
FilledCurve[{{Line[pts]}, {Line[smallpts]}}]}]
Original
pts = {{0, 0}, {2, 0}, {0, 4}};
in = {.7, 1};
smallpts = Mean[{#, in}] & /@ pts;
Graphics[{Red, Point[in], Green, Polygon[pts -...
4
For version V12.1. I couldn't figure out a way to get VectorScaling to do anything except the limited options listed in the docs. (The old VectorScale seemed simultaneously more versatile and inscrutable.)
interp[p_, q_, s_] := ( p (1 - s) + q (1 + s))/2;
Manipulate[
VectorPlot[{Cos[t]*(-y), Cos[t]*x}, {x, -1, 1}, {y, -1, 1},
VectorScaling -> ...
4
Clear["Global`*"]
a = 1; c = 1;
b = -1; d = 1;
p = 1; q = -1;
f1 = (Exp[-2 r a] p)/(2 r c) + (Exp[-2 r b] p)/(2 r d);
f2 = (Exp[-2 r a] q)/(2 r c) + (Exp[-2 r b] q)/(2 r d);
Plot[Evaluate@Outer[
Tooltip@ConditionalExpression[#2, #1] &,
{r > 0, r < 0}, {f1, f2}], {r, -2, 2},
PlotLegends ->
{"f1;\[ThinSpace]r\[ThinSpace]&...
4
You can also construct a TemporalData object from your x and y and use it with ListLinePlot:
td = TemporalData[Table[y^i, {i, 4}], {x}];
llp = ListLinePlot[td,
PlotStyle -> {Red, Red, RGBColor[.45, .77, .92], RGBColor[.45, .77, .92]},
Filling -> {1 -> {2}, 3 -> {4}},
PlotRange -> {1, All}]
Alternatively, use Table[y^i, {i, 4}] as input ...
4
Try RegionFunction instead of Piecewise
VectorPlot3D[Sqrt[4 - (x^2 + y^2 + z^2)] {y, -x, 0}, {x, -2, 2}, {y, -2,2}, {z, -2, 2}
, RegionFunction -> Function[{x, y, z}, 4 > (x^2 + y^2 + z^2)],VectorPoints -> Fine]
or alternatively Boole
VectorPlot3D[Boole[4 > (x^2 + y^2 + z^2)] Sqrt[4 - (x^2 + y^2 + z^2)] {y, -x,0}
, {x, -2, 2}, {y, -2, 2}, {z, -...
4
Use PlotStyle -> Directive[{Red, Thick, CapForm["Butt"]}] (CapForm["Mitter"] also works):
plot = With[{XZ = 170, YZ = 230, m = 1.5},
Plot[{-Sqrt[x^2 + 1], Sqrt[x^2 + 1], Sqrt[0.5 x], -Sqrt[0.5 x],
Sqrt[-0.5 x], -Sqrt[-0.5 x]}, {x, -2.5, 2.5},
PlotRange -> {-2, 2},
PlotStyle -> Directive[{Red, Thick, CapForm["...
4
Here's another way to do it using ImplicitRegion and the finite element method package.
Needs["NDSolve`FEM`"]
ℛ =
ImplicitRegion[y^2 + z^2 <= (Sqrt[E^-x (1 + E^x)^2])^2, {x, y, z}];
(bmesh = ToBoundaryMesh[ℛ, {{0, 4}, {-8, 8}, {-8,
8}}])["Wireframe"]
One possible advantage of using this approach is that the mesh will likely ...
4
Quiet@Plot[{Interpolation[curveb][x],
ConditionalExpression[mod1[x], 0 <= x <= 400],
ConditionalExpression[mod2[x], 100 <= x <= 370],
If[x <= 200, mod1[100], mod2[300]]},
{x, 0, 400},
PlotRange -> {0, 200},
PlotStyle -> {Blue, {Black, Dashed}, {Black, Dashed}, {Thin, Gray}},
BaseStyle -> Thick,
Exclusions -> ...
4
I think the recursion behavior is due to the use of Subscript(See 77625).
To solve this problem:
Stop using subscripts for evaluations.
Use Clear["Subscript", "x"] to clean the definitions(which are cleaned by your Quit).
4
With correct Mathematica syntax and increased range of x,y RegionPlot solves your problem:
RegionPlot[ 3 Pi/4 < Arg[x + I y] <= 5 Pi/4 && 1 <= Abs [x + I y] < 2 , {x, - 2,2}, {y, - 2, 2} ]
addendum
Thanks to the comment @Bili Debili: Arg returns angle in the range -Pi...Pi, that's why the condition 3 Pi/4 < Arg[x + I y] <= 5 Pi/4 ...
3
array = Array[Subscript[m, ##] &, {8, 5}];
{checkmark, dot} = {"✓", "\[FilledSmallCircle]"};
labeledcells = Join[Thread[{1, Range[5]}], {{2, 1}, {8, 1}}];
markedcells = {{2, 2}, {4, 3}, {6, 5}};
dottedcells = Complement[Tuples[{Range[8], Range[5]}], labeledcells, markedcells];
array2 = ReplacePart[array, {markedcells :> checkmark,...
3
Here's a way to take advantage of some of the built-in probability stuff. I couldn't find or remember what distribution does the sum of dice. TransformedDistribution didn't work (or I made an error).
dicedist = DiscreteUniformDistribution[Table[{1, 6}, {5}]];
(* roll the dice *)
RandomVariate[dicedist]
(* {1, 6, 4, 6, 5} *)
mu = Total@Mean[dicedist];
...
3
rolls = Table[Table[RandomChoice[Range[6]], {5}], {10000}];
sums = Total /@ rolls;
fig1 = Histogram[sums, {0.5, 31.5, 1}, "PDF"];
mean = Mean@sums;
std = StandardDeviation@sums;
fig2 = Plot[PDF[NormalDistribution[mean, std], x], {x, 0, 30},
Ticks -> None, Axes -> None];
Show[{fig1 , fig2}]
If you wanna use count, then
rolls = Table[Table[...
3
The ErrorBarPlots package is obsolete. Instead of it, you can use the built in functionality provided by Around, but you need your data in a different format.
From your B2 and original data, first transform your data, then plot:
witherrs = B2 /. {{x_, y_}, ErrorBar[err_]} :> {x, Around[y, err]};
ListLogPlot[
{data, witherrs},
Joined -> {True, ...
3
I wonder if something like this is what you’re after:
ListLogLinearPlot[
data,
Filling -> Axis,
FillingStyle -> Thickness[0.02],
Axes -> False, Frame -> True
]
3
Something is wrong on your side. It may be lingering definitions, or something else elusive, but your code works with the definitions you provided.
I would only recommend NOT starting with $b=0$ and $c=0$, because that will correspond to an empty plot... (Note the explicitly non-zero starting values in the Manipulate below)
Pccxx[x_, b_, c_] = c (x - 1) + b (...
3
Clear["Global`*"]
f[x_] = Sin[x];
The tangent line at x0
t[x_, x0_] := (x - x0)*f'[x0] + f[x0]
Put the annotations in an Epilog
Plot[Sin[x], {x, 1, 1.5}, PlotRange -> {{0.8, 1.75}, {0.75, 1.05}},
Epilog -> {
Text[Style["A", 14], {1, f[1]}, {-2, 0}],
Text[Style[Subscript["T", "A"], 14], {.9, t[.9, 1]}, {-...
3
Update: A post-processing function that works more generally:
ClearAll[fixPolarTicks]
fixPolarTicks[offset_: 15][g_] :=
Module[{aspectr = (AspectRatio /. Options[g, AspectRatio]),
pr = (PlotRange /. Options[g, PlotRange]) /. {{All, All}, {All, All}} ->
RegionBounds[Quiet@DiscretizeGraphics[g]], xylengths, oo},
xylengths = -Subtract @@@ ...
3
One more way is as follows.
ComplexRegionPlot[ Pi/4 < Arg [z] <= 5 Pi/4 && 1 <= Abs [z] < 2, {z, -2 - 0*I, 2 + 2*I},AspectRatio->Automatic]
3
ParametricPlot[
ReIm[r*Exp[I*θ]], {θ, π/4, (5 π)/4}, {r, 1, 2},
MeshFunctions -> {#3 &, #4 &},
Mesh -> {{{π/4, {Thick, Blue, Dashed}}, {(5 π)/
4, {Thick, Blue}}}, {{1, {Thick, Red}}, {2, {Thick, Red,
Dashed}}}}, BoundaryStyle -> None, PlotStyle -> Yellow]
2
I just found that I can use Grid which solves all the problem.
ListLinePlot[
Table[{k,
PDF[BinomialDistribution[50, p], k]}, {p, {0.3, 0.5, 0.8}}, {k, 0,50}],
Filling -> Axis,
FillingStyle -> Automatic,
(**Option-3**)
Prolog -> {Inset[Framed[Grid[{ {MaTeX["E_{x}"]}, {MaTeX["text2"]} }] ,
RoundingRadius -> 5, ...
Only top voted, non community-wiki answers of a minimum length are eligible
