Obtaining better quality in ListPlot

Strictly speaking what you observe is a bug in handling of the Point Graphics primitive by Export.

One workaround is to export to SVG format, edit it and then save as EPS. Here is a way to go (some numbers may be version-specific, I use Mathematica 9.0.1):

Export["test.svg",
  StringReplace[ExportString[S0, "SVG"], 
    "rx='0.5' ry='0.5'" -> "rx='0.2' ry='0.2'"], "String"]

The exported SVG file can be opened by Inkscape 0.48.3.1 and then saved to EPS or PDF format. Here is how exported PDF file looks in Adobe Acrobat 11:

screenshot

You can tune the size 0.2 of the circles for your taste.

EDIT

In a comment @cormullion suggets more direct approach which does not require an intermediate program:

Export["test.eps",
  StringReplace[ExportString[S0, "EPS"], {"\t" -> " ", " 1 w" -> " 0.3 w"}], "String"]

EDIT 2

Here is another, much more direct approach:

S0 = Graphics[{Disk[#, .01] & /@ data}, Axes -> False, Frame -> True, 
   FrameLabel -> {"x", OverDot["x"]}, RotateLabel -> False, 
   FrameStyle -> Directive[FontSize -> 17, FontFamily -> "Helvetica"],
    PlotRange -> {{-10.1, 11}, {-45, 45}}, ImageSize -> 550, 
   AspectRatio -> 1/GoldenRatio];
Export["pss_plot.eps", S0];

Here is how exported EPS file looks opened in Acrobat 11:

screenshot 2

EDIT 3

Here is a way to export EPS file with rasterized plot (about 900 kb in size):

S0 = Graphics[{Disk[#, Offset[.3]] & /@ data}, Axes -> False, 
   Frame -> True, FrameLabel -> {"x", OverDot["x"]}, 
   RotateLabel -> False, 
   FrameStyle -> Directive[FontSize -> 17, FontFamily -> "Helvetica"],
    PlotRange -> {{-10.1, 11}, {-45, 45}}, ImageSize -> 550, 
   AspectRatio -> 1/GoldenRatio];

Export["pss_plot.eps", 
  Rasterize[Style[S0, Antialiasing -> False], "Image", 
   ImageResolution -> 1000]];

If you need higher resolution you can increase the ImageResolution. If you want to add a preview to the EPS file, use the "PreviewFormat" option:

Export["pss_plot.eps", 
  Rasterize[Style[S0, Antialiasing -> False], "Image", 
   ImageResolution -> 1000], "PreviewFormat" -> "TIFF"];

Note that rasterization with high resolution requires a lot of memory and Mathematica cannot use more than approximately 1.2 Gb of memory under 32 bit systems. The memory requirements can be reduced by incremental rendering (see the "EDIT 4" section below).

Here is how exported plot looks in Adobe Acrobat (I switched off downsampling for bitmap images in Acrobat's EPS → PDF conversion settings):

screenshot 3

EDIT 4

For completeness, here I present an incremental rendering technique which allows substantially reduce the memory requirements when rendering Mathematica's graphics with high resolution. It works both for Graphics and Graphics3D. Note that for the current task I convert the image to grayscale for saving memory, generally it is not necessary.

One can also note the loose of FrameLabel - it is due to a bug in FullGraphics, the latter is used for avoiding a bug in ImageResolution which causes diminished FrameTicks. These bugs are not critical for this application: instead of FullGraphics one can use the CustomTicks package which "fixes" all these bugs.

S0 = Show[
   FullGraphics[
     Graphics[{}, Axes -> False, Frame -> True, 
      PlotRange -> {{-10.1, 11}, {-45, 45}}, 
      AspectRatio -> 1/GoldenRatio]] /. 
    AbsoluteThickness[_] -> Thickness[Medium], 
   AspectRatio -> 1/GoldenRatio, 
   Epilog -> {Disk[#, Scaled[.0004 {1, GoldenRatio}]] & /@ data}, 
   BaseStyle -> {FontSize -> Scaled[.02], FontFamily -> "Helvetica"}, 
   ImageSize -> {360, Round[360/GoldenRatio]}, 
   ImagePadding -> {{Scaled[.04], Scaled[.01]}, {Scaled[.04], 
      Scaled[.01]}}];
p = Graphics[Inset[S0, {0, 0}, Center, {1, 1}], 
  PlotRangePadding -> None, ImagePadding -> None, ImageMargins -> 0, 
  PlotRange -> {{-1/2, 1/2}, {-1/2, 1/2}}]

divisions = 4;
bins = Partition[FindDivisions[{-1/2, 1/2}, divisions], 2, 1];
plotRanges = Table[{x, y}, {y, Reverse@bins}, {x, bins}];
fileNames = 
  Table[FileNameJoin[{$TemporaryDirectory, 
     "temp part " <> ToString[i] <> ".mx"}], {i, 1, 
    Length[Flatten[plotRanges, 1]]}];

Do[Print@Export[fileNames[[i]], 
   ColorConvert[
    Rasterize[Show[p, PlotRange -> Flatten[plotRanges, 1][[i]]], 
     "Image", ImageResolution -> 400], "Grayscale"]], {i, 1, 
  Length[Flatten[plotRanges, 1]]}]

(*ImageTake drops last line of white pixels: it is a bugfix*)
Export["Graphics.eps", 
 ImageAssemble[
  Partition[
   Table[ImageTake[Import[file], {1, -2}], {file, fileNames}], 
   divisions]]];

FileByteCount["Graphics.eps"]

DeleteFile /@ fileNames;

1653237

We have generated a 8000x8000 image and exported it to EPS. Here is how it looks in Acrobat:

screenshot 3


Poincaré sections like this are terrible when you include them in a multi-page PDF document (e.g. via $\LaTeX$) as vector graphics because they slow down then scrolling and paging for the reader, to the point where it becomes unbearable. Vector graphics is simply an inefficient and inappropriate way to represent graphics that mainly consist of giant point clouds. In particular for publication purposes, you should always convert such plots to bitmap!

It's not so much the storage that't the problem, it's the fact that the PDF interpreter has to decode the points every time you come to the page that displays your plot, and that takes a lot of pointless processing for lots of points (pun intended). Just export to PNG and forget about EPS.

Or (if you use an old $\LaTeX$ version) use the following trick from this answer to create your EPS file with rasterized points:

rasterTrick[plot_] := 
Show[plot, 
 Prolog -> {Opacity[0], Texture[{{{0, 0, 0, 0}}}], 
   VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}}, 
   Polygon[{{0, 0}, {.1, 0}, {.1, .1}}]}]

Export["t.eps", Style[S0 // rasterTrick, Magnification -> 2]]

Tags:

Graphics

Export

Plotting

Recent Posts