Speeding up density and contour plots

Question

Possible Slowdown in v11.1

I have a DensityPlot and ContourPlot I would like to speed up in V11.1.1. Is there any way to achieve a speed up in the following examples? Perhaps through parallelization or compilation?

AbsoluteTiming[
ContourPlot[
      Mod[Floor[-5 Im[Log[Log[Sin[Sin[x - I y] + Sin[y + I x]]]]]], 40], 
      {x, -3, 3}, {y, -3, 3}, 
      ContourLines -> False, Frame -> False, Background -> Black, 
      ColorFunction -> (RGBColor[1 - #^1.5, Abs[Sin[2 \[Pi] #]], 
         4 #^2 - 2 # + 3] &), 
      PlotPoints -> 200, Contours -> 45, 
      PerformanceGoal -> "Speed", 
      ContourLabels -> None]
]
(* takes over 20 mins *)

AbsoluteTiming[
   DensityPlot[
   Length[FixedPointList[(# - (Cos[#] + #^2/2)/(-Sin[#] + #)) &, 
     x + I y, 10, SameTest -> (Abs[#1 - #2] < 10^-10 &)]], {x, 5, 
    7}, {y, -4, -3}, Mesh -> False, AspectRatio -> Automatic, 
   Frame -> False, Axes -> False, 
   PlotPoints -> 200, PerformanceGoal -> "Speed",
   ColorFunction -> (If[# >= 1, RGBColor[0, 0, 0], Hue[1 - 2 #]] &)]]

(* takes over 20 mins *)

Note: part of the problem is that I'd like need to the resolution high by fixing the options PlotPoints and Contours.

Answer 1

This is I think a better way to do that first plot. The function actually returns only 40 discrete integer values (Which I think is giving ContourPlot issues ) so you are better off to essentially generate a raster image.

(dat = Table[
     Mod[Floor[-5 Im[Log[Log[Sin[Sin[x - I y] + Sin[y + I x]]]]]], 
       40] /. y -> 1, {x, -3, 3, 6/500}, 
      {y, -3, 3, 6/500}]); // AbsoluteTiming

385.829

ArrayPlot[dat, ColorFunction -> "Rainbow"]