Come posso aumentare la precisione del risultato di RegionPlot per questa funzione?
Ho questa funzione
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);
Voglio vedere in quale intervallo di variabili questa funzione è negativa. Utilizzando RegionPlot
RegionPlot[ f < 0, {y, 2, 2.25}, {x, 1.15, 1.17},
WorkingPrecision -> 30, PlotPoints -> 50]
Ottengo questa trama

Quindi, quando diminuisco gli intervalli come
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]
io ottengo

Qui, non è chiaro se le parti blu si toccano o meno. Come posso entrare più nel dettaglio per vedere se la parte blu è continua oppure no?
Risposte
La soluzione di plottaggio più semplice
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}
]
Ma le trame non sono sempre molto convincenti, essendo progettate per dare solo un'idea approssimativa di ciò che sta accadendo.
Soluzione analitica
Come ho mostrato in questa risposta a una domanda simile , possiamo mostrare analiticamente che c'è un nodo:
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 *)
Addomesticamento RegionPlot
RegionPlot
si è evoluto dall'introduzione della Region
funzionalità. RegionPlot
sembra utilizzare questa funzionalità per generare il grafico, e ignora l' WorkingPrecision
opzione, che è evidente dal rumore numerico. Credo che la funzionalità della regione sia basata sulla funzionalità FEM, disponibile solo nella precisione della macchina. (Allo stesso modo, l'opzione MaxRecursion
sembra defunta.)
Ecco un modo per controllare la precisione di lavoro:
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]
Ma una rondine non fa l'estate.
Dato che sei interessato a sapere se le due regioni si incontrano, puoi anche usare ContourPlot
, che sembra essere un po 'più stabile:
ContourPlot[f == 0, {y, 2.1299849, 2.1299855}, {x, 1.15970110, 1.15970113},
WorkingPrecision -> 40, MaxRecursion -> 6]
