Bagaimana saya dapat meningkatkan ketepatan hasil RegionPlot untuk fungsi ini?
Saya memiliki fungsi ini
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);
Saya ingin melihat dalam rentang variabel apa, fungsi ini negatif. Menggunakan RegionPlot
RegionPlot[ f < 0, {y, 2, 2.25}, {x, 1.15, 1.17},
WorkingPrecision -> 30, PlotPoints -> 50]
Saya mendapatkan plot ini

Kemudian, ketika saya mengurangi rentang sebagai
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]
Saya mendapatkan

Di sini, tidak jelas apakah bagian biru itu bersentuhan atau tidak. Bagaimana saya bisa menjelaskan lebih detail untuk melihat apakah bagian biru itu kontinu atau tidak?
Jawaban
Solusi plot paling sederhana
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}
]
Tetapi plot tidak selalu meyakinkan, dirancang untuk memberikan gambaran kasar tentang apa yang sedang terjadi.
Solusi analitik
Seperti yang saya tunjukkan dalam jawaban ini untuk pertanyaan serupa , kami dapat secara analitis menunjukkan ada node:
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 *)
Penjinakan RegionPlot
RegionPlot
telah berkembang sejak diperkenalkannya Region
fungsionalitas. RegionPlot
tampaknya menggunakan fungsi ini untuk menghasilkan plot, dan itu mengabaikan WorkingPrecision
opsi, yang terbukti dari derau numerik. Saya yakin fungsionalitas wilayah didasarkan pada fungsionalitas FEM, yang hanya tersedia dalam presisi mesin. (Demikian pula, opsi tersebut MaxRecursion
tampaknya tidak berfungsi.)
Berikut adalah cara untuk mengukur kontrol presisi kerja:
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]
Tapi seekor burung layang-layang tidak cocok untuk musim panas.
Karena Anda tertarik pada apakah kedua wilayah tersebut bertemu, Anda juga dapat menggunakan ContourPlot
, yang tampaknya sedikit lebih stabil:
ContourPlot[f == 0, {y, 2.1299849, 2.1299855}, {x, 1.15970110, 1.15970113},
WorkingPrecision -> 40, MaxRecursion -> 6]
