Bagaimana saya dapat meningkatkan ketepatan hasil RegionPlot untuk fungsi ini?

Aug 17 2020

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

3 MichaelE2 Aug 17 2020 at 20:00

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

RegionPlottelah berkembang sejak diperkenalkannya Regionfungsionalitas. RegionPlottampaknya menggunakan fungsi ini untuk menghasilkan plot, dan itu mengabaikan WorkingPrecisionopsi, yang terbukti dari derau numerik. Saya yakin fungsionalitas wilayah didasarkan pada fungsionalitas FEM, yang hanya tersedia dalam presisi mesin. (Demikian pula, opsi tersebut MaxRecursiontampaknya 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.

2 Hausdorff Aug 17 2020 at 20:05

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]