How to take advantage of symmetries of a function when making its `DensityPlot`?

Question

I want to obtain a density plot of a function fun[x, y] that is slow to evaluate. It takes many hours to get a density plot. As a simple example, we define the following function:

fun[x_, y_] := (Pause[0.0001]; Sin[x y]^2)

We want to obtain the following density plot:

DensityPlot[fun[x, y], {x, -2, 2}, {y, -2, 2}]

Since this function has symmetries $x\to -x$ and $y\to -y$, the information in the first quadrant is sufficient.

DensityPlot[fun[x, y], {x, 0, 2}, {y, 0, 2}]

In my computer, it takes 2.78 seconds to get the first plot, while 1.56 seconds to get the second one. When we use the second plot to save some time, how to obtain the first plot by using the result of the second plot?

Answer 1

ClearAll[reflectF]
reflectF = Show[#, MapAt[GeometricTransformation[#, 
   ReflectionTransform /@ {{-1, 0}, {0, -1}, {-1, -1}}] &, #, {1}], 
  PlotRange -> All] &;

Example:

DensityPlot[fun[x, y], {x, -2, 2}, {y, -2, 2}] // AbsoluteTiming

(dp = DensityPlot[fun[x, y], {x, 0, 2}, {y, 0, 2}]) // AbsoluteTiming

reflectF @ dp // AbsoluteTiming

Answer 2

You can generate a Table and use ListDensityPlot.

data = Flatten[Table[{x,y,fun[x, y]},{x, -2, 2, 0.1},{y, -2, 2, 0.1}], 1];//AbsoluteTiming
ListDensityPlot[data] // AbsoluteTiming

{0.004211, Null}

data = Flatten[Table[{x,y,fun[x, y]},{x,0,2,0.1},{y,0,2,0.1}],1]; // AbsoluteTiming
data = Join[data, data /. {x_, y_, z_} :> {-x, y, z}, 
                  data /. {x_, y_, z_} :> {-x, -y, z}, 
                  data /. {x_, y_, z_} :> {x, -y, z}]; // AbsoluteTiming
ListDensityPlot[data] // AbsoluteTiming

{0.001187, Null}

{0.001483, Null}

You would see a significant reduction in time when using a complicated function where evaluation requires more time compared to plotting.

To use the Mathe-Mesh

mesh = DensityPlot[fun[x, y], {x, 0, 2}, {y, 0, 2}, PlotPoints -> 10][[1, 1]];
data = Table[{p[[1]], p[[2]], fun[p[[1]], p[[2]]]}, {p, mesh}]; 

data = Join[data, data /. {x_, y_, z_} :> {-x, y, z}, 
                  data /. {x_, y_, z_} :> {-x, -y, z}, 
                  data /. {x_, y_, z_} :> {x, -y, z}]; // AbsoluteTiming

ListDensityPlot[data, Mesh -> All]

The number of mesh points can be controlled by PlotPoints in mesh

Answer 3

You can use Reap/Sow to get the function's values as MA tabulates the function for plot:

fun[x_, y_] := Sin[x y]^2
{graph, {data}} = 
  Reap[DensityPlot[z = fun[x, y]; Sow[{x, y, z}]; 
             z, {x, 0, 2}, {y, 0, 2}]];

Clear[z]
tmp = Cases[
   data, {x_/;NumberQ[x], y_/;NumberQ[y], 
     z_} -> {{x, y, z}, {-x, y, z}, {-x, -y, z}, {x, -y, z}}];
symdata = DeleteDuplicates[Flatten[tmp, 1]];

ListDensityPlot[sym]

Notice, the function is evaluated only in the DensityPlot

Answer 4

If your concern is quality then you can use this which is also pretty fast. You can find the code here.

fun[x_, y_] := Sin[x y]^2
data = Table[fun[x, y], {x, -2, 2, 0.005}, {y, -2, 2, 0.005}];

renderImage[array_?MatrixQ, cf_, q_Integer: 2048, 
  opts : OptionsPattern[Image]] := 
 Module[{tbl}, 
  tbl = List @@@ Array[cf, q, {0`, 1`}] // N // 
    Developer`ToPackedArray;
  Image[tbl[[# + 1]] & /@ Round[(q - 1`) array], opts]]

img = renderImage[Rescale[data], 
   ColorData["M10DefaultDensityGradient"]];

Graphics[Inset[img, {-2, -2}, {0, 0}, {4, 4}], Axes -> False, 
 Frame -> True, PlotRange -> {{-2, 2}, {-2, 2}}, 
 PlotRangePadding -> 0.1]