Bu işlev için RegionPlot sonucunun kesinliğini nasıl artırabilirim?
Bu işleve sahibim
f := 1024 (1 - (9 x^2)/4)^2 Cosh[(π x)/
3]^2 Sinh[π x]^2 (8 (16 - 216 x^2 +
81 x^4 + (4 + 9 x^2)^2 Cosh[(2 π x)/3]) Sinh[π x]^2 -
1/256 ((4 + 9 x^2)^2 Sinh[x (2 π - y)] +
2 (64 - 144 x^2 + (4 + 9 x^2)^2 Cosh[(2 π x)/3]) Sinh[
x y] - 9 (4 - 3 x^2)^2 Sinh[x (2 π + y)])^2);
Hangi değişken aralığında bu fonksiyonun negatif olduğunu görmek istiyorum. RegionPlot Kullanımı
RegionPlot[ f < 0, {y, 2, 2.25}, {x, 1.15, 1.17},
WorkingPrecision -> 30, PlotPoints -> 50]
Bu arsayı elde ediyorum

Ardından, aralıkları azalttığımda
RegionPlot[
f < 0, {y, Rationalize[2.1299849, 0], Rationalize[2.1299855, 0]}, {x,
Rationalize[1.15970110, 0], Rationalize[1.15970113, 0]},
WorkingPrecision -> 90, PlotPoints -> 150]
Elde ederim

Burada mavi kısımların birbirine değip değmediği belli değil. Mavi kısmın sürekli olup olmadığını görmek için nasıl daha fazla ayrıntıya girebilirim?
Yanıtlar
En basit çizim çözümü
ContourPlot[f,
{y, Rationalize[2.1299849, 0], Rationalize[2.1299855, 0]},
{x, Rationalize[1.15970110, 0], Rationalize[1.15970113, 0]},
ContourShading ->
{RGBColor[0.368417, 0.506779, 0.709798, 0.4], None},
Contours -> {{0}},
PlotPoints -> 25, WorkingPrecision -> 32,
Method -> {"TransparentPolygonMesh" -> True}
]
Ancak olaylar her zaman pek inandırıcı değildir, sadece neler olup bittiğine dair kaba bir fikir verecek şekilde tasarlanmıştır.
Analitik çözüm
Bu yanıtta benzer bir soruya gösterdiğim gibi , analitik olarak bir düğüm olduğunu gösterebiliriz:
jac = D[f, {{x, y}}];
cpsol = FindRoot[jac == {0, 0}, {{x, 1.15}, {y, 2.13}},
WorkingPrecision -> 50];
cpt = {x, y} /. cpsol
f /. cpsol (* shows cpt is on curve *)
f /. N[cpsol] (* show numerical noise at cpt is substantial *)
(* {1.1597011139328870007473930523093558428367204499142, 2.1299852028277681162523681416937176426970454505325} 0.*10^-36 0.0119859 *)
Evcilleştirme RegionPlot
RegionPlot
Region
işlevselliğin başlangıcından bu yana gelişmektedir . RegionPlot
arsa oluşturmak için bu işlevselliği kullanıyor gibi görünüyor WorkingPrecision
ve sayısal gürültüden anlaşılan seçeneği yok sayıyor . Bölge işlevselliğinin, yalnızca makine hassasiyetinde mevcut olan FEM işlevine dayandığına inanıyorum. (Benzer şekilde, seçenek MaxRecursion
geçersiz görünüyor.)
İşte çalışma hassasiyetinin kontrolünü ele geçirmenin bir yolu:
ClearAll[fff];
fff[x0_Real, y0_Real] :=
Block[{x = SetPrecision[x0, Infinity],
y = SetPrecision[y0, Infinity]},
N[
1024 (1 - (9 x^2)/4)^2 Cosh[(π x)/
3]^2 Sinh[π x]^2 (8 (16 - 216 x^2 +
81 x^4 + (4 + 9 x^2)^2 Cosh[(2 π x)/
3]) Sinh[π x]^2 -
1/256 ((4 + 9 x^2)^2 Sinh[x (2 π - y)] +
2 (64 - 144 x^2 + (4 + 9 x^2)^2 Cosh[(2 π x)/3]) Sinh[
x y] - 9 (4 - 3 x^2)^2 Sinh[x (2 π + y)])^2),
$MachinePrecision]
];
RegionPlot[
fff[x, y] < 0,
{y, Rationalize[2.1299849, 0], Rationalize[2.1299855, 0]},
{x, Rationalize[1.15970110, 0], Rationalize[1.15970113, 0]},
PlotPoints -> 100]
Ama bir yutmak yaz uyandırmaz.
İki bölgenin bir araya gelip gelmediğiyle ilgilendiğiniz için ContourPlot
, biraz daha kararlı görünen şunu da kullanabilirsiniz :
ContourPlot[f == 0, {y, 2.1299849, 2.1299855}, {x, 1.15970110, 1.15970113},
WorkingPrecision -> 40, MaxRecursion -> 6]
