0
$\begingroup$

I have to do a RegionPlot of this strange function

func =  (x y)^2/z^2 Abs[1 - 1/(x)^2] < 1/(210)^2;

I do it with

plotFunc = RegionPlot[func  /. z -> 10, {x, -1, 1}, {y, -1, 1}, BoundaryStyle -> None,
                      PerformanceGoal -> "Quality", PlotPoints -> 250]

where I needed the PerformanceGoal and PlotPoints to improve the quality of my plot.

Now, I have to overlap plots of this kind for different values of $z$ but I am not sure of the set of color to use, I would like to just change the color at the end, when I'll do the Overlap[...] or Show[...]

Mathematica takes 13 secs to do the plot.

Is there a way to let Mathematica process the points of the plot once for all and then change quickly the color without wasting 13 secs of my time every time I want just to change the color?

I hope my question is clear.

$\endgroup$
  • $\begingroup$ Plot is a reserved symbol, so you cannot assign anything to it. $\endgroup$ – J. M. will be back soon Nov 7 '17 at 10:53
  • 1
    $\begingroup$ You have a spare parenthesis in your definition of func... which becomes funct in your plot. Also, Plot has a built in meaning. Don't try using it for anything else. $\endgroup$ – aardvark2012 Nov 7 '17 at 10:53
  • $\begingroup$ sorry, I just changed the name to the variables incorrectly when I reported them on SE. I edited my question. $\endgroup$ – apt45 Nov 7 '17 at 11:01
  • $\begingroup$ Your expression for func still has a syntax error. $\endgroup$ – J. M. will be back soon Nov 7 '17 at 11:02
  • $\begingroup$ @J.M. now that the spare parenthesis has been removed, do you know the answer? $\endgroup$ – apt45 Nov 7 '17 at 11:50
1
$\begingroup$

Let me know if this fits your needs:

ClearAll[func, zSpec, plots];
func[x_, y_, z_] := (x y)^2/z^2 Abs[1 - 1/(x)^2] < 1/(210)^2;

zSpec = Range[0, 100, 10];
(color[#] = Blend["TemperatureMap", #/100]) & /@ zSpec;


 (* change plotting setting however you want, I don't have time to try with 250 plot points. 
    Just don't touch PlotStyle
 *)

plots = Table[
   (RegionPlot[func[x, y, #], {x, -1, 1}, {y, -1, 1}, 
        BoundaryStyle -> None, PerformanceGoal -> "Quality", 
        PlotPoints -> 250, PlotStyle -> Blue] /. 
       Directive[a___, Blue, b___] :> 
        Dynamic[Directive[a, color[#], b]]) &[z]
   , {z, zSpec}];

Panel@Grid[{
   {Row @ plots, SpanFromLeft}
   ,
   {
    Show[Reverse@plots, ImageSize -> 500],
    Panel@
     Grid[{"z = ", #, " : ", ColorSlider[Dynamic[color[#]]]} & /@ 
       zSpec],
    Button[
     "Reset", (color[#] = Blend["TemperatureMap", #/100]) & /@ zSpec, 
     ImageSize -> CurrentValue["DefaultButtonSize"]]
    }}, Alignment -> {Left, Top}
  ]

enter image description here

$\endgroup$
1
$\begingroup$

The quick-and-dirty method is to perform a preliminary discretization of your region, and then extract the needed points and polygons for subsequent styling:

With[{z = 10}, 
     reg = BoundaryDiscretizeRegion[
         ImplicitRegion[(x y)^2/z^2 Abs[1 - 1/x^2] < 1/210^2, {{x, -1, 1}, {y, -1, 1}}], 
         MaxCellMeasure -> {1 -> 0.01}, Method -> "Semialgebraic"]];

pts = MeshCoordinates[reg]; polys = MeshCells[reg, 2];

Graphics[{Red, GraphicsComplex[pts, polys]}]

colored discretized region

$\endgroup$
1
$\begingroup$

Reducing the number of point increases the speed of calculation. I have tried with this guessing what you want:

pl = {};
maxz = 15;
Do[
   func = (x y)^2/z^2 Abs[1 - 1/(x)^2] < 1/(210.)^2;
   colf[z_] := Blend[{Yellow, Red}, N@(z/maxz)];
   plotFunc = RegionPlot[Evaluate@(func), {x, -1, 1}, {y, -1, 1}, 
   PlotPoints -> 100, BoundaryStyle -> None, PlotStyle -> colf[z]];
   pl = AppendTo[pl, plotFunc],
   {z, 1, maxz}
  ]
Blend[pl]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.