11
cp = ContourPlot[EuclideanDistance[{-5, 0}, {x, y}] EuclideanDistance[{5, 0}, {x, y}],
{x, -15, 15}, {y, -11, 11},
Contours -> Range[5, 150, 20], Frame -> False,
ContourLabels -> (Text[Style[#3, Directive[Blue, 15]], {#1, #2}] &),
AspectRatio -> Automatic,
ColorFunction -> (If[# < 145, ColorData[{"TemperatureMap",...
9
$Version
(* "12.1.1 for Mac OS X x86 (64-bit) (June 19, 2020)" *)
Clear["Global`*"]
Version 12.1.1 also has mismatched FrameTicks on the left and right edges:
llp = ListLogPlot[
Table[{x, x^-10}, {x, 1, 5}],
GridLines -> Automatic,
Frame -> True]
Looking at the FrameTicks option values:
Cases[llp, HoldPattern[FrameTicks -&...
7
You can use AxisObject to add additional ticks. For example, for the ticks on the horizontal axis:
ListLinePlot[
data,
PlotRange -> All,
PlotStyle -> Black,
GridLines -> {(os - 1) 2 + 1, data[[(os - 1) 2 + 1]]},
GridLinesStyle -> Directive[Black],
Epilog -> AxisObject[
Line[{{0,0},{34,0}}],
{0,34},
...
6
Simplifying and evaluating the argument will also reduce the redundant labels.
$Version
(* "13.0.0 for Mac OS X x86 (64-bit) (December 3, 2021)" *)
ContourPlot[
Evaluate[
Simplify[
EuclideanDistance[{-5, 0}, {x, y}]*
EuclideanDistance[{5, 0}, {x, y}]]],
{x, -15, 15}, {y, -11, 11},
Contours -> Range[5, 150, 20],
Frame -> False,
...
6
Something like:
Clear["Global`*"]
dat = RandomReal[{0, 1}, {10, 2}];
t1 = 0.02 Table[{Cos[p], Sin[p]}, {p, 0, 2 Pi, 2 Pi/5}];
t2 = 0.005 Table[{Cos[p], Sin[p]}, {p, 2 Pi/10, 2 Pi, 2 Pi/5}];
star[r_] := Line[(r + #) & /@ Riffle[t1, t2]]
Graphics[star /@ dat]
5
plot1 = Plot[{2 x + 4, -6 x - 1}, {x, -2, 4}, PlotLegends -> "Expressions"];
plot2 = Plot[{2 x + 4, -6 x - 1}, {x, -1, 3}, Filling -> {1 -> {2}}];
Show[plot1, plot2]
5
Do not have time to make a full Manipulate, but you can start with
Clear["Global`*"]
g[t_]:=((1-b) y[t]^2/t^n+1/t^(2+n))^n;
ode=y'[t]+3/2 (a-b) y[t]/t+(3/2 a-1)/y[t] t^3==g[t];
pfun=ParametricNDSolveValue[{ode/.{a->3/4,b->5},y[1]==1},y,{t,1,2},{n}]
Plot[Evaluate[Table[pfun[n][t],{n,Range[5]}]],{t,1,2},
PlotRange->{Automatic,{-10,10}},...
5
The problem is that you are evaluating Log on all elements of pointsLHTL, not just the x values. The y values are negative so the Log is imaginary.
Lm = LinearModelFit[pointsLHTL /. {x_, y_} :> {Log@x, y}, x, x]
Lmplot =
Plot[Lm[x], {x, -16, -14}, PlotStyle -> Directive[Blue, Dashed],
PlotLegends -> {"Linear fit"}]
Show[Lmplot, ...
4
Using PolygonMarker:
datasets = RandomReal[{0 , 2.5}, {4, 20, 2}];
Graphics[{FaceForm[], EdgeForm[{AbsoluteThickness[1], JoinForm["Miter"]}],
EdgeForm[Blue],
ResourceFunction["PolygonMarker"]["SixPointedStarSlim", Offset[7], datasets[[1]]],
EdgeForm[Red],
ResourceFunction["PolygonMarker"]["...
4
Or, simply
ListPlot[Prime[Range[10]] -> LabelString[[;; 10]], ImageSize -> 900,
Filling -> Axis, PlotTheme -> "Web"]
The length of the label list must equal the length of the data list, hence LabelString[[;; 10]]. The option, LabelingFunction, can be used to specify the location of the labels relative to the data points, if ...
4
You need to write"LabelingFunction -> (LabelString[[#[1]]] &)":
LabelString = Table[StringForm["Test # ``", LS], {LS, 1, 25}];
ListPlot[Prime[Range[10]],
LabelingFunction -> (LabelString[[#[[1]]]] &), Filling -> Axis]
3
Here is some code that should get you going.
The positions specify the left of the connection to the elements.
Clear["Global`*"]
con[pos1_, pos2_] := Line[{pos1, pos2}];(*connections*)
switch0[lab_ :
""] := {Line[{{{0, 0}, {0.3, 0}, {0.7, 0.25}}, {{0.7, 0}, {1,
0}}}], Text[lab, {0.5, +0.3}]};
switchh[pos_, lab_ : ""]...
3
Follow the approach by @Bob Hanlon.
I think the problem come from the Complex Function EuclideanDistance since it contain Sqrt and Abs.
EuclideanDistance[{a, b}, {x, y}]
(* Sqrt[Abs[a - x]^2 + Abs[b - y]^2] *)
So sometimes I avoid to use EuclideanDistance or Norm. Here we can use #.#& instead.
Sqrt[# . # &[{-5, 0} - {x, y}] # . # &[{5, 0} - {x, ...
3
Alternatively, you could use Callout
ListPlot[
Callout[Prime[#],
StringForm["Test # ``", #],
Above] & /@ Range[10],
ImageSize -> 900,
Filling -> Axis,
PlotTheme -> "Web"]
2
Let d be your data. Then
d1 = Cases[d, {x_, y_} /; Im[y] > -5]
d2 = Cases[d, {x_, y_} /; Im[y] < -5]
ListLinePlot[{Re[d1], Re[d2]}]
It happens that the Im[y] > -5 criterion works just fine for the data in the OP. In more complicated situations, a more complicated criterion will be needed, but the syntax remains.
2
plt = Plot[x, {x, 0, 25}
, Ticks -> {
Automatic,
{#, DecimalForm[1.0 #, {6, 2}]} & /@ Range[0, 25, 5]
}
]
2
$Version
"13.0.0 for Mac OS X x86 (64-bit) (December 3, 2021)"
Clear["Global`*"]
plt = Plot[x, {x, 0, 25}];
Modify the existing Ticks,
Show[plt,
Ticks -> {Automatic, (Ticks /. AbsoluteOptions[plt, Ticks])[[2]] /.
{y_, lbl_String?(StringLength[#] > 0 &), rest_} :>
{y, NumberForm[y, {5, 2}], rest}}]
2
We can divide data into two list as follows
up = Select[data, #[[2]] >= data[[2, 2]] &];
dw = Select[data, #[[2]] <= data[[1, 2]] &];
Now we can plot
{ListPlot[{up, dw}, PlotStyle -> Blue],
ListLinePlot[{up, dw}, Mesh -> All, MeshStyle -> Red,
PlotRange -> {{1.88, 2.2}, {0.39, 0.42}}, PlotStyle -> Blue]}
Update 1. Second ...
2
I figured out a solution: I needed to set the Mesh option to be higher. In this case, Mesh->100 worked fine.
1
Clear[F, G];
F = -((3 Sin[3 x])/(2 x)) -
Sqrt[-1 + (Cos[3 x] + (2 Sin[3 x])/
x + (Cos[2 x] - Cos[y]) Csc[2 x] Sin[3 x])^2];
G = Cos[3 x] + ((1 + 2 x Cot[2 x] - x Cos[y] Csc[x] Sec[x]) Sin[
3 x])/(2 x);
Reduce[{F == 0, G == 1, 0 < x <= 3, -1 <= y <= 1}, {x, y}]
Reduce[{F == 0, G == -1, 0 < x <= 3, -1 <= y <= 1}, {...
1
pl1 = Plot[Exp[x], {x, 0, 10}, PlotRange -> All]
pl2 = Plot[Exp[x], {x, 0, 5}
, GridLines -> Automatic
, PlotRange -> 50
, Background -> Nest[Lighter, Yellow, 3]]
pl3 = Plot[Exp[x]
, {x, 0, 10}
, PlotRange -> All
, GridLines -> Automatic
, Epilog -> {Inset[pl2, {2, 10000}, {0, 0}]}
]
Here (0,0) of the inset plot is ...
1
You are nearly there. But you misplaced the "Evaluate" command:
NumericalParametricPlot1 =
Show[ParametricPlot[
Evaluate[
Callout[{q[\[Phi]], q'[\[Phi]]} /. NumericalDiffequaWith,
StringForm["Test # ``", i], Above]], {\[Phi], 0, 100},
PlotStyle -> ColorList,
PlotLegends -> Placed[LegendWith, {Top, Left}], ...
1
use Rotate on the text directly
angles2 = {{0., 0.05922829252191935`}};
labels = {"AAAAAA"};
names = Text[
Style[Rotate[labels[[1]], Mean[angles2[[1]]] - \[Pi]/2], Red, 20],
1.1*{1.0995176865382061`, 0.032570799647401755`}, {0, 0}];
gg = Graphics[{names, Opacity[0.5], Red, Circle[], Rectangle[]},
ImageSize -> 200]
Export["xxx.pdf&...
1
Note that your data contains 2 y values for every x value. However, there is a bug, the exception is the 69'th point that does not have a pair. therefore delete point 69:
data = d0 = ToExpression /@ Import["d:/Downloads/testdata.csv"];
data = Delete[data, 69];
Now we separate the 2 curves using "Partition" and "Transpose":
data ...
1
Straight replacing the way you have done does not honor derivatives. You can do it this way:
sl[x_] = -D[p[x]*D[y[x], x], x] - q[x]*y[x]
res[x_] = sl[x] /. {p -> (1 &), q[x] -> 0} /. {y -> (Sin[#] &)}
(* Sin[x] *)
And you will get the plot you expect.
If you don't want to use pure functions you can do it this way:
sl[x] /. {p -> ...
1
Clear["Global`*"]
sl[p_, q_, y_, xv_, var_ : x] :=
(-D[p*D[y, var], var] - q*y) /. var -> xv
p[x_] = 1;
q[x] = 0;
y[x] = Sin[x];
res[xv_] := sl[p[x], q[x], y[x], xv]
Plot[Evaluate@res[x], {x, 0, Pi}]
Another example,
p[x_] = x^2;
q[x] = Sqrt[x];
y[x] = x*Sin[x];
res[xv_] := sl[p[x], q[x], y[x], xv]
Note the equivalent use of the option ...
Only top voted, non community-wiki answers of a minimum length are eligible