Optimizing size of eps/pdf files generated by Mathematica

Question

How to optimize size of an eps or pdf file generated by Mathematica?

It is common that the file size is 50-100x bigger that it should be (an example below). For some applications (e.g. putting a figure in a publication, or even more - putting it on a large poster) I need to have axes in vector graphics, so using raster graphics for everything is not the best option for me.

Every practical solution (either with setting the right options in Mathematica or with doing further conversions in other applications) will be appreciated.

For example the following code producing an eps figure of:

plot = ListDensityPlot[
Table[Random[], {100}, {100}],
InterpolationOrder -> 0]

Export["testplot.eps", plot]
Export["testplot.pdf", plot]

produces an eps file of size of 3.3MB and a pdf size of 5MB (on Mathematica 7 on Mac OS X 10.6, if it makes a difference).

For a comparison, a 3x3 plot with the same axes has 8kB (pdf) to 20kB (eps). 100x100 points is 30kB in bmp (and a bit less in png).

The issue is the same for other types of plots, with the emphasis on ListPlot3D.

Answer 1

You may have figured out how to apply Alexey's answer in the link he provided. But in case you are having trouble here I provide how I apply the technique to 2D graphics.

I have found the hard way that if you want to create a good plot you need to be very specific to Mathematica. For this reason, as you may have noticed in my post Rasters in 3D I created an object specifying all the options so that Mathematica can be happy.

in = 72;
G2D = Graphics[{},
   AlignmentPoint -> Center, 
   AspectRatio -> 1,
   Axes -> False,
   AxesLabel -> None,
   BaseStyle -> {FontFamily -> "Arial", FontSize -> 12},
   Frame -> True,
   FrameStyle -> Directive[Black],
   FrameTicksStyle -> Directive[10, Black],
   ImagePadding -> {{20, 5}, {15, 5}},
   ImageSize -> 5 in, 
   LabelStyle -> Directive[Black],
   PlotRange -> All,
   PlotRangeClipping -> False,
   PlotRangePadding -> Scaled[0.02]
]; 

I should mention here that you must specify ImagePadding. If you set it to all your eps file will be different from what Mathematica shows you. In any case, I think having this object allows you to change properties much easily.

Now we can move on to your problem:

plot = ListDensityPlot[
  Table[Random[], {100}, {100}],
  InterpolationOrder -> 0,
  Options[G2D]
]

The following separates the axes and the raster and combines them into result:

axes = Graphics[{}, AbsoluteOptions[plot]];
fig = Show[plot, FrameStyle -> Directive[Opacity[0]]];
fig = Magnify[fig, 5];
fig = Rasterize[fig, Background -> None];
axes = First@ImportString[ExportString[axes, "PDF"], "PDF"];
result = Show[axes, Epilog -> Inset[fig, {0, 0}, {0, 0}, ImageDimensions[axes]]]

The only difference here, which at this point I cannot explain is the axes labels, they have the decimal point. Finally, we export them:

Export["Result.pdf", result];
Export["Result.eps", result];

The result are files of sizes 115 Kb for the pdf file and 168 Kb for the eps file.

UPDATE:

If you are using Mathematica 7 the eps file will not come up correctly. All you will see is your main figure with black on the sides. This is a bug in version 7. This however is fixed in Mathematica 8.

I had mentioned previously that I did not know why the axes label were different. Alexey Popkov came up with a fix for that. To create axes, fig and result use the following:

axes = Graphics[{}, FilterRules[AbsoluteOptions[plot], Except[FrameTicks]]];
fig = Show[plot, FrameStyle -> Directive[Opacity[0]]];
fig = Magnify[fig, 5];
fig = Rasterize[fig, Background -> None];
axes = First@ImportString[ExportString[axes, "PDF"], "PDF"];
result = Show[axes, Epilog -> Inset[fig, {0, 0}, {0, 0}, ImageDimensions[axes]]]