This is the HTML version of a Mathematica notebook, written for version 8 and 9. You can copy and paste the following into a notebook as literal plain text. For the motivation and further discussion of this notebook, see "Mathematica density and contour Plots with rasterized image representation".
This version has been updated to allow the option PlotLegends which was introduced in version 9.
When regular ContourPlot and ListContourPlot graphics are exported as PDF, the shading appears as a patchwork of polygons with distracting mesh lines. Also, it is impossible to make the contour shading translucent without introducing the mesh line artifacts. Instead of trying to pick out the mesh lines after the fact and adjusting their color or opacity, I decided that the polygons themselves are too much of a nuisance because they also bloat the PDF file.
The two functions rasterContourPlot and rasterListContourPlot defined here work essentially the same as ContourPlot and ListContourPlot, except that the contour shading is represented by a single rasterized image. Because an image can also have an alpha channel (transparency), there is one additional option you can specifiy:
"ShadingOpacity" -> 0 ... 1
rasterContourPlot[f_, rx_, ry_, opts : OptionsPattern[]] := Module[
{
img,
cont,
contL,
plotRangeRule,
contourOptions,
frameOptions,
rangeCoords
},
contourOptions =
Join[
FilterRules[{opts},
FilterRules[
Options[ContourPlot],
Except[{Background, Frame, Axes}]
]
],
{Frame -> None, Axes -> None}
];
contL = ContourPlot[f, rx, ry,
Evaluate@Apply[Sequence, contourOptions]
];
cont = First[Cases[{contL}, Graphics[__], Infinity]];
img = Rasterize[
Graphics[
GraphicsComplex[cont[[1, 1]], cont[[1, 2, 1]]],
PlotRangePadding -> None, ImagePadding -> None,
Options[cont, PlotRange]
], "Image",
ImageSize -> With[
{size =
Total[{2, 0} (ImageSize /. {opts}) /.
{ImageSize ->
CurrentValue[ImageSize]}]},
If[NumericQ[size],
size,
First[WindowSize /. Options[EvaluationNotebook[]]]
]
]
];
plotRangeRule = FilterRules[Quiet@AbsoluteOptions[cont], PlotRange];
rangeCoords = Transpose[PlotRange /. plotRangeRule];
frameOptions = Join[
FilterRules[{opts},
FilterRules[Options[Graphics],
Except[{PlotRangeClipping, PlotRange}]
]
],
{plotRangeRule, Frame -> True, PlotRangeClipping -> True}
];
If[Head[contL] === Legended, Legended[#, contL[[2]]], #] &@
Show[
Graphics[
{
Inset[
Show[
SetAlphaChannel[img,
"ShadingOpacity" /. {opts} /. {"ShadingOpacity" -> 1}
], AspectRatio -> Full
],
rangeCoords[[1]], {0, 0}, rangeCoords[[2]] - rangeCoords[[1]]
]
},
PlotRangePadding -> None
],
Graphics[
GraphicsComplex[cont[[1, 1]], cont[[1, 2, 2]]],
PlotRangePadding -> None,
ImagePadding -> None
],
Evaluate@Apply[Sequence, frameOptions]
]
]
rasterListContourPlot[pList_, opts : OptionsPattern[]] := Module[
{img,
cont,
contL,
plotRangeRule,
contourOptions,
frameOptions,
rangeCoords
},
contourOptions = Join[
FilterRules[{opts},
FilterRules[Options[ListContourPlot],
Except[{Background, Frame, Axes}]]
],
{Frame -> None, Axes -> None}
];
contL = ListContourPlot[pList,
Evaluate@Apply[Sequence, contourOptions]
];
cont = First[Cases[{contL}, Graphics[__], Infinity]];
img = Rasterize[
Graphics[
GraphicsComplex[cont[[1, 1]], cont[[1, 2, 1]]],
PlotRangePadding -> None, ImagePadding -> None,
Options[cont, PlotRange]
], "Image",
ImageSize -> With[{size =
Total[{2, 0} (ImageSize /. {opts}) /. {ImageSize ->
CurrentValue[ImageSize]}]},
If[NumericQ[size],
size,
First[WindowSize /. Options[EvaluationNotebook[]]]
]
]
];
plotRangeRule = FilterRules[AbsoluteOptions[cont], PlotRange];
rangeCoords = Transpose[PlotRange /. plotRangeRule];
frameOptions = Join[
FilterRules[{opts},
FilterRules[Options[Graphics],
Except[{PlotRangeClipping, PlotRange}]]
],
{plotRangeRule, Frame -> True, PlotRangeClipping -> True}
];
If[Head[contL] === Legended, Legended[#, contL[[2]]], #] &@
Show[
Graphics[
{
Inset[Show[
SetAlphaChannel[img,
"ShadingOpacity" /. {opts} /. {"ShadingOpacity" -> 1}],
AspectRatio -> Full],
rangeCoords[[1]], {0, 0}, rangeCoords[[2]] - rangeCoords[[1]]
]
},
PlotRangePadding -> None
],
Graphics[
GraphicsComplex[cont[[1, 1]], cont[[1, 2, 2]]]
],
Evaluate@Apply[Sequence, frameOptions]
]
]
The ability to set an opacity for the contour shading makes it easy to add additional material in the Prolog of the graphic:
rasterContourPlot[Re[1/(x + I y)], {x, -1, 1}, {y, -1, 1},
GridLines -> Automatic, Contours -> 15, "ShadingOpacity" -> .5,
ColorFunction -> Hue,
Prolog ->
Rotate[Text[
Style["Watermark", FontSize -> 64,
GrayLevel[.5]], {0, .3}], π/4], FrameLabel -> {"x", "y"},
ImageSize -> Automatic]
Let's define a list of data that describes a 2D height field:
grid = Transpose[
Table[Sum[((-1)^n*(Sin[(2*n + 1)*y]/(2*n + 1)^2))/
E^((2*n + 1)*x), {n, 0, 10}], {x, 0, π, π/24},
{y, 0, π, π/24}]];
Here we create a contour plot of the data, using rasterized shading with 50% opacity (it will be displayed below):
plot = rasterListContourPlot[grid,
DataRange -> {{0, π}, {0, π}},
ColorFunction -> "FallColors", InterpolationOrder -> 2,
"ShadingOpacity" -> .5, PlotRange -> All];
What if we want to superimpose this with another plot?
plot2 = Plot[
Evaluate@Table[π/2 + E^(-(2 n + 1) x), {n, 0, 4}], {x,
0, π}, PlotRangePadding -> 0, PlotRange -> All,
PlotStyle -> Thickness[.01], Filling -> Axis,
FillingStyle -> Orange];
To superimpose them, I put the contour plot on top to show that it is indeed translucent:
Show[plot2, plot, Axes -> None, Frame -> True]
