# Is there an alternative way instead of increasing the number of plotpoints in RegionPlot to get a better result?

I have this function and I use RegionPlot to see in which part of the domain, the function is negative:


f := 1/4 x^2 Sinh[(2 \[Pi] x)/
3]^2 Sinh[\[Pi] x]^2 (-512 Sinh[(\[Pi] x)/3] +
128 x^2 Sinh[(\[Pi] x)/3] + 64 Sinh[\[Pi] x] +
32 x^2 Sinh[\[Pi] x] + 4 x^4 Sinh[\[Pi] x] -
128 Sinh[(5 \[Pi] x)/3] - 64 x^2 Sinh[(5 \[Pi] x)/3] -
8 x^4 Sinh[(5 \[Pi] x)/3] + 576 Sinh[(7 \[Pi] x)/3] -
96 x^2 Sinh[(7 \[Pi] x)/3] + 4 x^4 Sinh[(7 \[Pi] x)/3])^2 -
4 (256 Cosh[(2 \[Pi] x)/3]^2 - 128 x^2 Cosh[(2 \[Pi] x)/3]^2 +
16 x^4 Cosh[(2 \[Pi] x)/3]^2 +
256 x^2 Sinh[(2 \[Pi] x)/
3]^2) Sinh[\[Pi] x]^2 (64 Sinh[(\[Pi] x)/3]^2 -
32 x^2 Sinh[(\[Pi] x)/3]^2 + 4 x^4 Sinh[(\[Pi] x)/3]^2 -
16 Sinh[(\[Pi] x)/3] Sinh[\[Pi] x] -
4 x^2 Sinh[(\[Pi] x)/3] Sinh[\[Pi] x] +
x^4 Sinh[(\[Pi] x)/3] Sinh[\[Pi] x] +
1/4 x^6 Sinh[(\[Pi] x)/3] Sinh[\[Pi] x] + Sinh[\[Pi] x]^2 +
x^2 Sinh[\[Pi] x]^2 + 3/8 x^4 Sinh[\[Pi] x]^2 +
1/16 x^6 Sinh[\[Pi] x]^2 + 1/256 x^8 Sinh[\[Pi] x]^2 -
256 Cosh[(2 \[Pi] x)/3]^2 Sinh[\[Pi] x]^2 +
128 x^2 Cosh[(2 \[Pi] x)/3]^2 Sinh[\[Pi] x]^2 -
16 x^4 Cosh[(2 \[Pi] x)/3]^2 Sinh[\[Pi] x]^2 +
32 Sinh[(\[Pi] x)/3] Sinh[(5 \[Pi] x)/3] +
8 x^2 Sinh[(\[Pi] x)/3] Sinh[(5 \[Pi] x)/3] -
2 x^4 Sinh[(\[Pi] x)/3] Sinh[(5 \[Pi] x)/3] -
1/2 x^6 Sinh[(\[Pi] x)/3] Sinh[(5 \[Pi] x)/3] -
4 Sinh[\[Pi] x] Sinh[(5 \[Pi] x)/3] -
4 x^2 Sinh[\[Pi] x] Sinh[(5 \[Pi] x)/3] -
3/2 x^4 Sinh[\[Pi] x] Sinh[(5 \[Pi] x)/3] -
1/4 x^6 Sinh[\[Pi] x] Sinh[(5 \[Pi] x)/3] -
1/64 x^8 Sinh[\[Pi] x] Sinh[(5 \[Pi] x)/3] +
4 Sinh[(5 \[Pi] x)/3]^2 + 4 x^2 Sinh[(5 \[Pi] x)/3]^2 +
3/2 x^4 Sinh[(5 \[Pi] x)/3]^2 + 1/4 x^6 Sinh[(5 \[Pi] x)/3]^2 +
1/64 x^8 Sinh[(5 \[Pi] x)/3]^2 -
144 Sinh[(\[Pi] x)/3] Sinh[(7 \[Pi] x)/3] +
60 x^2 Sinh[(\[Pi] x)/3] Sinh[(7 \[Pi] x)/3] -
7 x^4 Sinh[(\[Pi] x)/3] Sinh[(7 \[Pi] x)/3] +
1/4 x^6 Sinh[(\[Pi] x)/3] Sinh[(7 \[Pi] x)/3] +
18 Sinh[\[Pi] x] Sinh[(7 \[Pi] x)/3] +
6 x^2 Sinh[\[Pi] x] Sinh[(7 \[Pi] x)/3] -
1/4 x^4 Sinh[\[Pi] x] Sinh[(7 \[Pi] x)/3] -
1/8 x^6 Sinh[\[Pi] x] Sinh[(7 \[Pi] x)/3] +
1/128 x^8 Sinh[\[Pi] x] Sinh[(7 \[Pi] x)/3] -
36 Sinh[(5 \[Pi] x)/3] Sinh[(7 \[Pi] x)/3] -
12 x^2 Sinh[(5 \[Pi] x)/3] Sinh[(7 \[Pi] x)/3] +
1/2 x^4 Sinh[(5 \[Pi] x)/3] Sinh[(7 \[Pi] x)/3] +
1/4 x^6 Sinh[(5 \[Pi] x)/3] Sinh[(7 \[Pi] x)/3] -
1/64 x^8 Sinh[(5 \[Pi] x)/3] Sinh[(7 \[Pi] x)/3] +
81 Sinh[(7 \[Pi] x)/3]^2 - 27 x^2 Sinh[(7 \[Pi] x)/3]^2 +
27/8 x^4 Sinh[(7 \[Pi] x)/3]^2 -
3/16 x^6 Sinh[(7 \[Pi] x)/3]^2 +
1/256 x^8 Sinh[(7 \[Pi] x)/3]^2);
RegionPlot[a f < 0, {x, 3.46572, 3.46574}, {a, 0, 1},
PlotPoints -> 60]


This is the result:

I am sure that the blue part should be a continuous domain. How can I get a better result? Is there an alternative way instead of increasing the number of plotpoints? Since it is not easy for my system and it takes much time.

• You mention ContourPlot in the title and text but it is RegionPlot in the code.
– JimB
Aug 9, 2020 at 14:47
• @JimB Thanks. I meant RegionPlot.
– user73733
Aug 9, 2020 at 15:29

f can be simplified (and I would use = rather than :=):

f = FullSimplify[f]
(*  -2 (-4 + x^2)^2 (1 + Cosh[(2 π x)/3] +
Cosh[(4 π x)/3])^2 (155392 - 153856 x^2 + 8608 x^4 - 144 x^6 -
x^8 - 256 (-6 + x) (6 + x) (32 - 28 x^2 + x^4) Cosh[(2 π x)/3] -
64 (-3776 + 2768 x^2 - 212 x^4 + 3 x^6) Cosh[(4 π x)/3] -
64 (-12 + x^2) (208 - 96 x^2 + 3 x^4) Cosh[2 π x] -
128 (-12 + x^2)^2 (-4 + x^2) Cosh[(8 π x)/3] +
(-12 + x^2)^4 Cosh[(10 π x)/3]) Sinh[(π x)/3]^6 *)


Then a plot of f over an appropriate range shows where f is negative:

Plot[f, {x, Rationalize[3.46572838, 0], Rationalize[3.46572842, 0]}, WorkingPrecision -> 30]


Now the RegionPlot:

RegionPlot[a f < 0, {x, Rationalize[3.46572838, 0], Rationalize[3.46572842, 0]}, {a, 0, 1},
PlotPoints -> 60, WorkingPrecision -> 30]


So you end up with a rectangle. Am I missing something? (Yes, the display of the horizontal axis tick mark labels needs work.)

If it is a ContourPlot that you want, then the following might work:

ContourPlot[a f, {x, Rationalize[3.46572838, 0], Rationalize[3.46572842, 0]}, {a, 0, 1},
Contours -> 10^22 Range[-10, 0], PlotPoints -> 60,
WorkingPrecision -> 50, FrameLabel -> {"x", "a"},
PlotLegends -> Automatic]


• Thanks for your perfect answer. But I do not understand how you obtained these values $[3.46572838, 0], [3.46572842, 0]$? And also about the last part in ContourPlot, why did you choose the range $[-10,0]$?
– user73733
Aug 9, 2020 at 16:38
• Trial and error. I first plotted f with Plot[f, {x, 3.46572, 3.46574}, PlotPoints -> 60] and then zeroed in on the values of x that were near zero. The range that showed the negative values (which a f < 0 would still always be negative as a >= 0) was chosen for the range of x. Then I used the range of negative values of f to obtain 10^22 Range[-10,0].
– JimB
Aug 9, 2020 at 18:04
• To find where f is nonpositive use FunctionDomain: FunctionDomain[Sqrt[-f], x] Aug 10, 2020 at 2:47