EnhancedGraphics

by Markus Lischka

The EnhancedGraphics package defines a modified graphics layout for all plot routines: improved tick labels typeset in Helvetica, frames instead of axes, and an adjustable line width. It provides functions for using the Ticks option of graphics objects allowing the length and style of tick marks and the text labels to be altered. It also provides an enhanced ContourPlot function and a new export function for EPS files which includes required Math fonts in the EPS file thus making it portable.

Reference

Title

EnhancedGraphics.m — Improved graphics layout made easy.

Author

Markus Lischka (mlischka@physik.tu-muenchen.de)

Summary

The EnhancedGraphics package defines a modified graphics layout for all plot routines: improved tick labels typeset in Helvetica, frames instead of axes, and an adjustable line width. It provides functions for using the Ticks option of graphics objects allowing the length and style of tick marks and the text labels to be altered. It also provides an enhanced ContourPlot function and a new export function for EPS files which includes required Math fonts in the EPS file thus making it portable.

Copyright

© Copyright 2001, Markus Lischka.
© Copyright 1994, Tom Wickham-Jones (Ticks functions).

Permission is granted to distribute this file for any purpose except for inclusion in commercial software or program collections. This copyright notice must remain intact.

Notebook Version

1.8

Mathematica Version

4.0

History

Version 1.0: Initial version (2001-02-15).
The Ticks functions are based on the package ExtendGraphics`Ticks` (Version 1.0, summer 1992) by Tom Wickham-Jones as described in his book "Mathematica Graphics: Techniques and Applications". 

Version 1.1: Fixed some inconsistencies when $LineStyle was set to a list of graphics directives (2001-03-20).

Version 1.2: Added wrapper for ContourPlot routine to avoid mismatch of contour styles (2001-04-12).

Version 1.3: Modified ContourPlot routine so that all explicitly specified contour lines are actually drawn (2001-04-24).

Version 1.4: Improved TickPosition: It now handles minor and major tick marks consistently for TickNumbers->Automatic. In previous versions, incommensurate spacings for major and minor tick marks could result due to the fixed ratio of 8 to 32.

Version 1.5: Added new system default $PlotStyle and three sample style sets optimized for screen ($ColoredPlotStyle) and PostScript output ($DashedPlotStyle, $ColoredDashedPlotStyle).

Version 1.6: Avoid numerical inconsistencies when determining the number of digits for tick labels (new routine determineDigits replaces routines totalDigits and fractionalDigits).

Version 1.7: Initial submission to MathSource; original package name BetterGraphics changed to EnhancedGraphics (2003-03-19).

Version 1.8: Changed default settings for Ticks option in analogy to FrameTicks. Added support for Graphics`Graphics` plot routines and included bug fix of Graphics`Graphics`Private`transformticks. Font inclusion is now disabled by default on Mathematica 4.2.0 or higher (2003-04-27).

Keywords

graphics layout, tick marks, tick labels, export, EPS, Math fonts

Source

Tom Wickham-Jones, Mathematica Graphics: Techniques and Applications, TELOS/Springer-Verlag 1994 (http://www.mathsource.com/Content/Enhancements/Graphics/3D/0208-976).
P. J. Hinton, emmathfnt - A Toolkit for Embedding Mathematica Fonts in EPS Files (http://www.mathsource.com/Content/Enhancements/Graphics/General/0210-519).
Maeder, R. Programming in Mathematica, 3rd ed. Addison-Wesley, 1996.

Warnings

The tick mark functions are written to mimick Mathematica's default behavior as close as possible, but there might still be some inconsistencies!

With embedded fonts, EPS files get significantly larger. If possible, try embedding them via dvips for the whole document.

The builtin ContourPlot routine is overriden, so be aware of any conflicts with other extensions or future versions of Mathematica!

Furthermore, at least up to Mathematica 4.1, a bug in the Graphics`Graphics` package prevents the use of TickFunction for logarithmic plots (if numerically equidistant tick labels were desired). See the discussion in Section "Implementation / Definitions for system functions / Graphics`Graphics` options". To work around this problem, the private Graphics`Graphics`Private`transformticks function is changed. These modifications might break future versions of Graphics.m.

Note: all cells marked as "InitializationCell" will be written to the Auto-Save package. This package can then be read in programs that use it with Needs["Template`"]. Cells not intended to belong to the package should not have this property.

Limitation

The current implementation of ExportEPS only works on Unix platforms as it uses a pipe construction for file output. It requires emmathfnt to be found in the current command path. As described in README.txt of emmathfnt, it only works when invoked by the frontend (and not by a standalone kernel)!
In Mathematica 4.2.0, the font export changed and is no longer supported by emmathfnt (see http://forums.wolfram.com/mathgroup/archive/2002/Nov/msg00563.html). In Mathematica 4.2.1 or higher, Mathematica is directly capable of exporting EPS with embedded fonts. In these cases, the default value of the IncludeFonts option is set to False.

TickFunction does not provide any support for creating logarithmic tick labels. The corresponding options for logarithmic plot routines of Graphics`Graphics` are thus set in such a way to not use TickFunction on scaled axes.

Discussion

The variable $FontsDirectory must be adapted to the system-specific path of the Mathematica Type 1 fonts directory if the fonts are not installed in the standard sub-directory!

Requirements

emmathfnt (MathSource /Enhancements/Graphics/General/0210-519)
Graphics`Graphics`
Utilities`FilterOptions`

Interface

This part declares the publicly visible functions, options, and values.

Set up the package context, including public imports

BeginPackage["Graphics`EnhancedGraphics`", "Graphics`Graphics`", "Utilities`FilterOptions`"];

Usage messages for the exported functions and the context itself

$LineStyle::usage = "$LineStyle gives the default setting for the line style in Graphics objects (lines, axes and tick marks). It should evaluate to a graphics directive like Thickness or AbsoluteThickness.";

$PlotStyle::usage = "$PlotStyle gives the default style(s) to use for lines or points to be plotted.";

$ColoredPlotStyle::usage = 
$DashedPlotStyle::usage = 
$ColoredDashedPlotStyle::usage = "$ColoredPlotStyle, DashedPlotStyle and $ColoredDashedPlotStyle are sample plot styles for Plot and ListPlot.";

Pt::usage = "Pt[x] converts the length x (in cm) to PostScript points as needed for the ImageSize option.";

ExportEPS::usage = "ExportEPS[\"file.eps\", graphics] exports the graphics object in EPS format. By default, required Math fonts are embedded. This behaviour can be switched off with the option IncludeFonts->False. The Mathematica font directory must be set by the option FontsDirectory.";

RemoveClip::usage = "RemoveClip is an option for ExportEPS that specifies whether PostScript clip commands should be removed from the EPS file. This is useful for labels outside the standard plot region which are otherwise not visible. The default is RemoveClip->False. This feature is only supported on Unix systems.";

IncludeFonts::usage = "IncludeFonts is an option for ExportEPS that specifies whether Math fonts should be embedded in exported EPS files or not. The default is IncludeFonts->True. This feature is only supported on Unix systems using Mathematica up to version 4.1.";

FontsDirectory::usage = "FontsDirectory is an option for ExportEPS that specifies the path to the Mathematica Type 1 fonts. The default is FontsDirectory->$FontsDirectory.";

$FontsDirectory::usage = "$FontsDirectory gives the default setting for the FontsDirectory option in the ExportEPS function.";

TickPosition::usage = "TickPosition[min, max, num] returns a list of at most num nicely rounded positions between min and max. These can be used for tick mark positions. TickPosition[min, max, Automatic] returns {majorTicks, minorTicks} where majorTicks and minorTicks are a list of the major and minor tick marks respectively as chosen according to Mathematica's defaults.";

TickFunction::usage = "TickFunction is a function that can be used with the Ticks option to alter the appearance of tick marks.";

TicksOnly::usage = "TicksOnly is a function that can be used with the Ticks option to produce tick marks without labels (using TickFunction).";

MajorLength::usage = "MajorLength is an option of TickFunction that specifies the length of major tick marks. MajorLength -> {0.00625, 0} specifies that major ticks should extend 0.00625 inside the axis and not outside.";

MinorLength::usage = "MinorLength is an option of TickFunction that specifies the length of minor tick marks. MinorLength -> {0.003125, 0} specifies that minor ticks should extend 0.003125 inside the axis and not outside.";

MajorStyle::usage = "MajorStyle is an option of TickFunction that specifies the style in which major tick marks should be rendered.";

MinorStyle::usage = "MinorStyle is an option of TickFunction that specifies the style in which minor tick marks should be rendered.";

TextFunction::usage = "TextFunction is an option of TickFunction that specifies a function to process tick mark labels. The default is TextFunction->TrimText. Mathematica's standard labels may be reproduced by TextFunction->Automatic.";

TrimText::usage = "TrimText is a function that can be used as the value of the TextFunction option of TickFunction to make sure that all tick mark labels are the same length.";

TickLabels::usage = "TickLabels is an option of TickFunction that gives the positions and text to use for tick-labels.  The value of TickLabels must be {{pos1, lab1}, {pos2, lab2}, ..}.";

TickNumbers::usage = "TickNumbers is an option of TickFunction that gives the number of major and minor tick marks. The default setting is TickFunction->{8,32}.";

ContourStyle::usage = ContourStyle::usage <> " If both contour lines and a list of styles are specified, the styles are applied in a one-to-one correspondence.";

Error messages for the exported objects

ExportEPS::notsupp = "The IncludeFonts and RemoveClip options are only supported on Unix systems! Use IncludeFonts->False and RemoveClip->False.";

Implementation

This part contains the actual definitions and any auxiliary functions that should not be visible outside.

Begin the private context (implementation part)

Begin["`Private`"];

Unprotect any system functions for which definitions will be made

protected = Unprotect[ ContourPlot ];

Definition of auxiliary functions and local (static) variables

Support function for ExportEPS[]: fixImageSize[]

This function works around two bugs in Mathematica's Export function (Version 4.0):
First, if the ImageSize option is already specified in the Graphics object, the value given to Export does not override the option setting of the Graphics object. The new ImageSize setting thus has to be embedded directly in the Graphics object.
Second, if the aspect ratio is greater than 1 and only the width is specified via the ImageSize option, Export uses the ImageSize value for the height of the EPS file (in contrast to the notebook frontend which uses the given value for the width of the image in all cases). We thus provide both the width and the height to get a properly scaled EPS file.

fixImageSize[gr_, opts___?OptionQ] :=
    Module[{imgsize, aspr},
        imgsize = ImageSize /. {opts} /. Options[gr];
        If[NumericQ[imgsize],
            (* only image width specified *)
            aspr = AspectRatio /. AbsoluteOptions[gr, AspectRatio];
            gr /. (Rule[ImageSize, _] -> Rule[ImageSize, {imgsize, aspr * imgsize}]),

            (* Automatic or width/height pair specified *)
            gr /. (Rule[ImageSize, _] -> Rule[ImageSize, imgsize])
        ]
    ];

Support functions for TickFunction[]

Check number of major and minor tick marks. Automatic is used to invoke Mathematica's internal routines:

checkTickNumbers[Automatic] := Automatic;
checkTickNumbers[{x_Integer, y_Integer}] :=
	If[x > 0 && y > 0, {x,y}, checkTickNumbers[]];
checkTickNumbers[_] := {8, 32};

If the tick label is approximately integer, trim its decimals and return integer numbers. For labels with magnitude >(10^5), the real format is kept so that the plot routine finally produces labels in scientific format :

trimDecimal[x_?VectorQ] :=
	Map[If[Log[10.0, Abs[#]] < 5.0 && # == Round[#], Round[#], #, #]&, x]

Support functions for TrimText[]

Determine number of total and fractional digits. The last digit is generally discarded to avoid rounding errors. Furthermore, if the last digit is 9, all trailing 9s are discarded. This works around a numerical inconsistency in RealDigits: At least in Mathematica 4.1, 
RealDigits[5.35] returns {{5,3,4,9,9,9,...},1} instead of {{5,3,5,0,0,0,...},1}.

determineDigits[num_?NumericQ] :=
	Module[{digs, len, total, fractional},
        {digs, len} = RealDigits[num];
		If[Last[digs] == 9,
			total = Max[1, Length[digs //. {x__, 9} -> {x}]],
			total = Length[Drop[digs,-1] //. {x__, 0} -> {x}]
		];
		fractional = Max[0, total - len];
		{total, fractional}
	];

Definition of the exported functions

$LineStyle

The new default line style used in graphics objects:

$LineStyle = AbsoluteThickness[0.5];

Pt[]

This function converts length specification in centimeters to PostScript points:

Attributes[Pt]={Listable};

Pt[cm_]:=(cm/2.54)*72;
Pt[cm1_,cm2_]:={Pt[cm1],Pt[cm2]};

$FontsDirectory

The standard fonts directory (default installation path):

$FontsDirectory = $TopDirectory <> "/SystemFiles/Fonts/Type1/";

ExportEPS[]

ExportEPS is basically a wrapper function around emmathfnt. It uses the standard Export function together with a Unix pipe to achieve the desired result. It can thus include fonts only on a Unix system. Starting with Mathematica 4.2.0, font handling in EPS files changed and is no longer supported by emmathfnt, so this option is set to True only if all requirements are fulfilled (see Reference/Limitation):

If[($OperatingSystem == "Unix") && ($VersionNumber < 4.2),
    Options[ExportEPS] = {
        IncludeFonts -> True, 
        RemoveClip -> False, 
        FontsDirectory :> $FontsDirectory
        },
    Options[ExportEPS] = {
        IncludeFonts -> False, 
        RemoveClip -> False, 
        FontsDirectory :> $FontsDirectory
        }
];

ExportEPS also fixes some problems with the ImageSize option (see discussion above) and with clipped PostScript objects: If text objects are placed outside the automatic plot region via the Epilog option, they will get clipped in the exported EPS without respect to the chosen image size. If wanted, the PostScript clip command is thus generally removed with a sed script.

ExportEPS[filename_String, gr_, opts___?OptionQ] := 
    Module[{opt, cmd1, cmd2, pipe},
        opt = Join[{opts}, Options[ExportEPS]];
        If[$OperatingSystem =!= "Unix" &&
            (IncludeFonts || RemoveClip) /. opt,
            Message[ExportEPS::notsupp];
            Return[$Failed]
        ];

        cmd1 = "sed -e 's/^clip$//'";
        cmd2 = "emmathfnt -d " <> (FontsDirectory /. opt);

        (* construct pipe *)
        Which[
            RemoveClip && IncludeFonts /. opt,
                pipe = "!" <> cmd1 <> " | " <> cmd2 <> " > " <> filename,
            RemoveClip && !IncludeFonts /. opt,
                pipe = "!" <> cmd1 <> " > " <> filename,
            !RemoveClip && IncludeFonts /. opt,
                pipe = "!" <> cmd2 <> " > " <> filename,
            !RemoveClip && !IncludeFonts /. opt,
                pipe = filename
        ];

        (* standard export *)
        Export[pipe, fixImageSize[gr, opts], "EPS", 
            FilterOptions[Export, opts]]
    ];

TickPosition[]

Determine the best tick positions mimicking Mathematica's default positions. This and the following functions are adapted from the package ExtendGraphics`Ticks` by Tom Wickham-Jones.

TickPosition[x0_?NumericQ, x1_?NumericQ, num_Integer?Positive] :=
    Module[{dist, scale, min, delta, space},
		space = {1.0, 2.0, 2.5, 5.0, 10.0};
        dist = (x1-x0)/num;
        scale = 10.0^Floor[Log[10, dist]];
        dist = dist / scale;
        If[dist < 1.0, dist *= 10.0; scale /= 10.0];
        If[dist >= 10.0, dist /= 10.0; scale *= 10.0];
        delta = First[Select[space, (# >= dist)&]] scale;
        min = Ceiling[x0/delta]*delta;
		Table[Floor[x/delta + 0.5]*delta, {x, min, x1, delta}]
	];

TickPosition[x0_?NumericQ, x1_?NumericQ, 
	{numMaj_Integer?Positive, numMin_Integer?Positive}] :=
		{TickPosition[x0, x1, numMaj], TickPosition[x0, x1, numMin]};

We copy Mathematica's default positions by invoking Show[Graphics[{}]] on the desired plot range. Caution: This is only approximately correct as Mathematica calls the TickFunction with a slightly larger upper and lower bound, but hopefully it's good enough. The passed values for x0 and x1 are probably the ones of the frame box, not the specified plot range.

TickPosition[x0_?NumericQ, x1_?NumericQ, Automatic] :=
	Module[{g, ticks, maj, min},
		g = Show[Graphics[{}],
				PlotRange -> {x0, x1},
				Axes -> True,
				Ticks -> {None, Automatic},
				DisplayFunction -> Identity
			];
		ticks = FullOptions[g, Ticks][[2]];
		maj = #[[1]]& /@ Select[ticks, (#[[2]] =!= "")&];
		min = #[[1]]& /@ Select[ticks, (#[[2]] == "")&];
		
		{maj, min}
	];

TickFunction[]

Options[TickFunction] =	{
	MajorLength -> {0.00625, 0},
	MinorLength -> {0.003125, 0},
	MajorStyle :> Flatten[{$LineStyle}],
	MinorStyle :> Flatten[{$LineStyle}],
	TextFunction -> TrimText,
	TickLabels -> Automatic,
	TickNumbers -> Automatic
	};

TickFunction[x0_, x1_, opts___?OptionQ] :=
    Module[{opt, majlen, minlen, majstyle, minstyle, 
            textfun, labs, tnums, maj, min},
		opt = Join[{opts}, Options[TickFunction]];
        majlen = MajorLength /. opt;
        minlen = MinorLength /. opt;
        majstyle = MajorStyle /. opt;
        minstyle = MinorStyle /. opt;
        textfun = TextFunction /. opt;
        labs = TickLabels /. opt ; 
        tnums = checkTickNumbers[TickNumbers /. opt];

        If[textfun === Automatic, textfun = trimDecimal];

        {maj, min} = TickPosition[x0, x1, tnums];
        min = Complement[min, maj];
		maj = If[MatrixQ[labs],
		    Map[{#, ""}&, maj],
		    Transpose[{maj, textfun[maj]}]
		    ];
        maj = Map[{#[[1]], #[[2]], majlen, majstyle}&, maj] ;
		If[Apply[Plus, minlen] =!= 0,
		    min = Map[{#, "", minlen, minstyle}&, min];
		    maj = Join[maj, min]
		];
		If[MatrixQ[labs],
		    maj = Join[maj, Map[Join[#, {{0,0}}]&, labs]]
		];

		maj
	];

A second method to produce ticks withouth labels would be to strip labels from existing ticks. Cf. Graphics`Graphics`Private`striplabels for an implementation.

TicksOnly = 
    TickFunction[#1, #2, TextFunction -> (Table["", {Length[#]}]&)]&;

TrimText[]

TrimText[x_ /; VectorQ[x, NumericQ]] :=
    Module[{test, min, max, res},
        test = DeleteCases[Chop[x], 0 | 0.0];
		{max, min} = Max /@ Transpose[Map[determineDigits, test]];
		res = If[min == 0,
		    Map[ToString[Round[#]]&, x],
		    Map[ToString[PaddedForm[#, {max+min, min}]]&, x]
		    ];
		Map[StringReplace[#, " " -> ""]&, res]
	];

Definitions for system functions

ContourPlot[]

Cf. Programming in Mathematica, ch. 8.3.2:

$ContourPlotActive = True;

Styles of contour lines are applied to the drawn contour lines, not to the explicitly specified contour lines via the Contours option. If any specified contour lines are not plotted because they are out of the value range of the given function, styles will be mismatched! This cannot happen when using e.g. the default Contours->10.
The following code works around that problem: If the Contours option specifies an explicit list of contour levels (ListQ[cn]) and the ContourStyle option is a list of list of graphics styles (And @@ ListQ /@ cs), we adjust the options settings to avoid any mismatch. The contour plot is first generated to determine its maximum and minimum values. The contour levels and contour styles (if necessary, cyclically repeated) are then arranged in a one-to-one correspondence list {{level, {styles...}}...}. All levels outside of the value range are discarded and the remaining levels sorted in ascending order. The result is split up again to obtain a list of contours and a list of corresponding contour styles that are actually rendered.
To make sure that all explicitly specified contour lines are actually drawn, PlotRange is set to All. Cf. MathGroup discussion http://library.wolfram.com/mathgroup/archive/1999/Jan/msg00200.html.

ContourPlot[f__, opts___?OptionQ] /; $ContourPlotActive := 
	Block[{$ContourPlotActive = False},
		Module[{cn, cs, dspl, cp, min, max, sl},
			cn = Contours /. {opts} /. Options[ContourPlot];
			cs = ContourStyle /. {opts} /. Options[ContourPlot];
			dspl = DisplayFunction /. {opts} /. Options[ContourPlot];
			Which[
				(* Contours and corresponding styles explicitly specified *)
				ListQ[cn] && (And @@ (ListQ /@ cs)),
					cp = ContourPlot[f, DisplayFunction -> Identity, opts];

					If[Head[cp] === ContourGraphics,
						{min, max} = {Min[First[cp]], Max[First[cp]]};
						sl = Select[
								Transpose[{cn, PadRight[cs, Length[cn], cs]}],
								(#[[1]] >= min && #[[1]] <= max)&
							];
						{cn, cs} = If[Length[sl] > 0,
								Transpose[Sort[sl]],
								{cn, cs}
							];

						Show[cp, Contours -> cn, ContourStyle -> cs, PlotRange->All, 
							DisplayFunction -> dspl, FilterOptions[ContourGraphics, opts]],

						(* Error, so just return result: *)
						cp
					],
					
				(* Contours explicitly specified *)
				ListQ[cn],
					ContourPlot[f, PlotRange->All, opts],
				
				(* Else *)
				True,
					ContourPlot[f, opts]
			]
		]
	];

Plot options

$TextStyle = {FontFamily -> "Helvetica", FontSize -> 10.0};

$FormatType = TraditionalForm;

Dashing or color directives in $LineStyle will be overwritten by the explicit settings in the PlotStyle option:

$ColoredPlotStyle = {
	Flatten[{$LineStyle,GrayLevel[0]}],
	Flatten[{$LineStyle,RGBColor[1,0,0]}],
	Flatten[{$LineStyle,RGBColor[0,0,1]}],
	Flatten[{$LineStyle,RGBColor[0,1,0]}],
	Flatten[{$LineStyle,RGBColor[1,0,1]}],
	Flatten[{$LineStyle,RGBColor[0,1,1]}],
	Flatten[{$LineStyle,RGBColor[1,1,0]}]
	};

$PlotStyle = $ColoredPlotStyle;

These styles are optimized for PostScript printing:

$DashedPlotStyle = {
	Flatten[{$LineStyle,AbsoluteDashing[{}]}],
	Flatten[{$LineStyle,AbsoluteDashing[{0.5,2}]}],
	Flatten[{$LineStyle,AbsoluteDashing[{3,4}]}],
	Flatten[{$LineStyle,AbsoluteDashing[{6,4}]}],
	Flatten[{$LineStyle,AbsoluteDashing[{3,2,0.5,2}]}],
	Flatten[{$LineStyle,AbsoluteDashing[{6,2,0.5,2}]}],
	Flatten[{$LineStyle,AbsoluteDashing[{3,2,0.5,2,0.5,2}]}]
	};

$ColoredDashedPlotStyle = {
	Flatten[{$LineStyle,AbsoluteDashing[{}],GrayLevel[0]}],
	Flatten[{$LineStyle,AbsoluteDashing[{0.5,2}],RGBColor[1,0,0]}],
	Flatten[{$LineStyle,AbsoluteDashing[{3,4}],RGBColor[0,0,1]}],
	Flatten[{$LineStyle,AbsoluteDashing[{6,4}],RGBColor[0,1,0]}],
	Flatten[{$LineStyle,AbsoluteDashing[{3,2,0.5,2}],RGBColor[1,0,1]}],
	Flatten[{$LineStyle,AbsoluteDashing[{6,2,0.5,2}],RGBColor[0,1,1]}],
	Flatten[{$LineStyle,AbsoluteDashing[{3,2,0.5,2,0.5,2}],RGBColor[1,1,0]}]
	};

SetOptions[Plot,
    Axes -> False,
    Frame -> True,
    PlotStyle :> $PlotStyle,
    AxesStyle :> $LineStyle,
    FrameStyle :> $LineStyle,
    Ticks -> {TickFunction, TickFunction},
    FrameTicks -> {TickFunction, TickFunction, TicksOnly, TicksOnly}
    ];

SetOptions[ListPlot,
    Axes -> False,
    Frame -> True,
    PlotStyle :> $PlotStyle,
    AxesStyle :> $LineStyle,
    FrameStyle :> $LineStyle,
    Ticks -> {TickFunction, TickFunction},
    FrameTicks -> {TickFunction, TickFunction, TicksOnly, TicksOnly}
    ];

SetOptions[ParametricPlot,
    Axes -> False,
    Frame -> True,
    PlotStyle :> $PlotStyle,
    AxesStyle :> $LineStyle,
    FrameStyle :> $LineStyle,
    Ticks -> {TickFunction, TickFunction},
    FrameTicks -> {TickFunction, TickFunction, TicksOnly, TicksOnly}
    ];

SetOptions[ContourPlot,
    Axes -> False,
    Frame -> True,
    ContourStyle :> $LineStyle,
    AxesStyle :> $LineStyle,
    FrameStyle :> $LineStyle,
    Ticks -> {TickFunction, TickFunction},
    FrameTicks -> {TickFunction, TickFunction, TicksOnly, TicksOnly}
    ];

SetOptions[ListContourPlot,
    Axes -> False,
    Frame -> True,
    ContourStyle :> $LineStyle,
    AxesStyle :> $LineStyle,
    FrameStyle :> $LineStyle,
    Ticks -> {TickFunction, TickFunction},
    FrameTicks -> {TickFunction, TickFunction, TicksOnly, TicksOnly}
    ];

MeshStyle expects a list of graphics directives, so we have to make sure that $LineStyle gets expanded to a list:

SetOptions[DensityPlot,
    Axes -> False,
    Frame -> True,
    MeshStyle :> Flatten[{$LineStyle}],
    AxesStyle :> $LineStyle,
    FrameStyle :> $LineStyle,
    Ticks -> {TickFunction, TickFunction},
    FrameTicks -> {TickFunction, TickFunction, TicksOnly, TicksOnly}
    ];

SetOptions[ListDensityPlot,
    Axes -> False,
    Frame -> True,
    MeshStyle :> Flatten[{$LineStyle}],
    AxesStyle :> $LineStyle,
    FrameStyle :> $LineStyle,
    Ticks -> {TickFunction, TickFunction},
    FrameTicks -> {TickFunction, TickFunction, TicksOnly, TicksOnly}
    ];

SetOptions[Plot3D,
    Axes -> True,
    Boxed -> True,
    MeshStyle :> Flatten[{$LineStyle}],
    AxesStyle :> $LineStyle,
    BoxStyle :> $LineStyle,
    Ticks -> {TickFunction, TickFunction, TickFunction}
    ];

SetOptions[ListPlot3D,
    Axes -> True,
    Boxed -> True,
    MeshStyle :> Flatten[{$LineStyle}],
    AxesStyle :> $LineStyle,
    BoxStyle :> $LineStyle,
    Ticks -> {TickFunction, TickFunction, TickFunction}
    ];

ParametricPlot3D seems to have no option to specify its line or mesh style, so we only change the axes:

SetOptions[ParametricPlot3D,
    Axes -> True,
    Boxed -> True,
    AxesStyle :> $LineStyle,
    BoxStyle :> $LineStyle,
    Ticks -> {TickFunction, TickFunction, TickFunction}
    ];

Graphics`Graphics` options

The logarithmic plot routines of Graphics`Graphics` inherit our changed options, but not all settings are compatible. We try to work around this problem by manually correcting some of the options. The problem arises due to an insufficient ticks handling in Graphics`Graphics` and is corrected in the subsection below.

Erroneous tick handling in Graphics`Graphics`

Begin["Graphics`Graphics`Private`"];

A bug in Graphics`Graphics` (as released with Mathematica 4.0) prevents the use of TickFunction for labelling logarithmic scales. The cause of this bug is a wrong invocation of the original tick-specifying function in transformticks. The following modification (Graphics.m of Mathematica 4.0, line 711) fixes this problem:

transformticks[tfun_, f_, scale_, flag_:False] :=
    Composition[transformticks[#, f, scale]&, tfun[10^#1, 10^#2]&]

It is then possible to evaluate the following plot, for example:

LogPlot[Exp[x], {x, 1.05, 4}, 
        FrameTicks -> {TickFunction, TickFunction, TicksOnly, 
            TicksOnly}];

Note that, in any case, TickFunction does not work for logarithmic axes if it returns a tick mark at 0.0.

Furthermore, specifying Automatic for a linear axis where labels are stripped by default (top or right of frame) effectively fails to substitute Automatic. This is solved by modifying line 696 of Graphics.m:

transformticks[Automatic, fun_, _, flag_:False] :=
    If[TrueQ[flag] && (fun =!= Automatic), Composition[striplabels, fun], fun]

End[ ];

All options of plot routines in Graphics`Graphics` that inherit their options are corrected. Routines that set their options individually such as Histogram are not changed.

Options[LogPlot] = Options[ParametricPlot];
SetOptions[LogPlot,
    Ticks -> {TickFunction, Automatic},
    FrameTicks -> {TickFunction, Automatic, TicksOnly, Automatic}
    ];
Options[LinearLogPlot] = Options[LogPlot];

Options[LogLinearPlot] = Options[ParametricPlot];
SetOptions[LogLinearPlot,
    Ticks -> {Automatic, TickFunction},
    FrameTicks -> {Automatic, TickFunction, Automatic, TicksOnly}
    ];

Options[LogLogPlot] = Options[ParametricPlot];
SetOptions[LogLogPlot,
    Ticks -> {Automatic, Automatic},
    FrameTicks -> {Automatic, Automatic, Automatic, Automatic}
    ];

Options[LogListPlot] = Options[ListPlot];
SetOptions[LogListPlot,
    Ticks -> {TickFunction, Automatic},
    FrameTicks -> {TickFunction, Automatic, TicksOnly, Automatic}
    ];
Options[LinearLogListPlot] = Options[LogListPlot];

Options[LogLinearListPlot] = Options[ListPlot];
SetOptions[LogLinearListPlot,
    Ticks -> {Automatic, TickFunction},
    FrameTicks -> {Automatic, TickFunction, Automatic, TicksOnly}
    ];

Options[LogLogListPlot] = Options[ListPlot];
SetOptions[LogLogListPlot,
    Ticks -> {Automatic, Automatic},
    FrameTicks -> {Automatic, Automatic, Automatic, Automatic}
    ];

Options[PolarPlot] = Options[ParametricPlot];
Options[PolarListPlot] = Options[ListPlot];

Options[ErrorListPlot] = Options[Graphics];
SetOptions[ErrorListPlot,
    Axes -> False,
    Frame -> True,
    AxesStyle :> $LineStyle,
    FrameStyle :> $LineStyle,
    Ticks -> {TickFunction, TickFunction},
    FrameTicks -> {TickFunction, TickFunction, TicksOnly, TicksOnly}
    ];

Restore protection of system symbols

Protect[ Evaluate[protected] ];

End the private context

End[ ];

Epilog

This section protects exported symbols and ends the package.

Protect exported symbol

Protect[
    Pt, 
    ExportEPS, FontsDirectory, IncludeFonts, RemoveClip, 
    TickFunction, TickPosition, TrimText, TicksOnly, 
    TickLabels, TickNumbers, TextFunction, 
    MajorLength, MajorStyle, MinorLength, MinorStyle
    ];

End the package context

EndPackage[ ]

Examples, Tests

Needs["Graphics`EnhancedGraphics`"];

?Graphics`EnhancedGraphics`*

p = Plot[{Sin[x], Cos[x]}, {x, 0, 2 π}];

p = 
        Plot[Sin[x], {x, 0, 2}, Frame -> False, Axes -> True, 
          Ticks -> (TickFunction[#1, #2, 
                  MajorStyle -> Flatten[{$LineStyle}], 
                  MajorLength -> {0.004, 0.004}, 
                  MinorLength -> {0, 0}, 
                  TextFunction -> TrimText] &)];

p = 
        Plot[{x - 0.35, x - 0.25, x - 0.15, x - 0.05, x + 0.05, x + 0.15, 
            x + 0.25, x + 0.35}, {x, 0, 1}, PlotRange -> {0, 1}, 
          AspectRatio -> Automatic];

p = 
        Plot[{x - 0.35, x - 0.25, x - 0.15, x - 0.05, x + 0.05, x + 0.15, 
            x + 0.25, x + 0.35}, {x, 0, 1}, PlotRange -> {0, 1}, 
          AspectRatio -> Automatic, 
          PlotStyle -> $DashedPlotStyle];

p = 
        Plot[{x - 0.35, x - 0.25, x - 0.15, x - 0.05, x + 0.05, x + 0.15, 
            x + 0.25, x + 0.35}, {x, 0, 1}, PlotRange -> {0, 1}, 
          AspectRatio -> Automatic, 
          PlotStyle -> $ColoredDashedPlotStyle];

$LineStyle = AbsoluteThickness[2.0];

p = 
        ParametricPlot[{{Sin[t], Cos[t]}, {Sin[0.5  t], Cos[0.8  t]}}, {t, 0, 
            2  π}];

p = 
        ContourPlot[x^2 + y^2, {x, -1, 1}, {y, -1, 1}];

p = 
        DensityPlot[x^2 + y^2, {x, -1, 1}, {y, -1, 1}];

p = 
        Plot3D[Sin[x] 
            Cos[y], {x, -π, π}, {y, -π, π}];

p = 
        ParametricPlot3D[{Cos[x], Sin[x], 0.01  x^2}, {x, 0, 
            6  π}];

The ContourPlot routine is modified so that contour levels can be specified together with corresponding styles:

p = 
        ContourPlot[x^2 + y^2, {x, -1, 1}, {y, -1, 1}, 
          ContourShading -> False, 
          Contours -> {1.0, -1.0, 0.1, 0.55}, 
          ContourStyle -> {{$LineStyle, 
                RGBColor[1, 0, 0]}, {RGBColor[0, 1, 1]}, {RGBColor[0, 1, 
                  0]}, {AbsoluteDashing[{5, 5}], 
                RGBColor[0, 0, 1]}}];

Some of the advanced plotting routines from Graphics`Graphics` are also automatically using the new options. Using TickFunction, however, is only supported for non-scaled axes:

plots = {LogPlot, LogLinearPlot, LogLogPlot};
Map[#[{x^2, Exp[x], Log[x]}, {x, 1.01, 2.0}, 
            PlotRange -> {{0.999, 2.0}, All}] &, plots];

plots = {LogListPlot, LogLinearListPlot, LogLogListPlot};
funs = {Exp[x], Log[x], x^2};
MapThread[#1[Table[{x, #2}, {x, 1.01, 2.01, 0.05}], 
            PlotRange -> {{0.999, 2.0}, All}] &, {plots, 
          funs}];

p = 
        PolarPlot[{1, t/(2  π)}, {t, 0, 2  π}, 
          AspectRatio -> Automatic];

Mathematica's default image width is 288 pt, 4 inch or 10.16 cm:

Pt[10.16]

We now prepare a high-quality plot for EPS export. The standard tick marks are altered, the image size is explicitly given, and the color output is suppressed. A plot label is freely positioned using the Epilog option:

$LineStyle = AbsoluteThickness[0.5];
p = 
        Plot[{Sin[x], Cos[x]}, {x, 0, 2 π}, 
          FrameLabel -> {"α", "f(x)"}, 
          FrameTicks -> {TickFunction[#1,  #2,  
                  TickNumbers -> {15, 30}] &, TickFunction, 
              TickFunction[#1,  #2,  TickNumbers -> {15, 30},  
                  TextFunction -> (Table["", {Length[#]}] &)] &, 
              TicksOnly}, ImageSize -> Pt[15.0, 12.0], 
          ColorOutput -> None, 
          Epilog -> {Text["Sine and Cosine", 
                Scaled[{0.5, 1.1}], {0, 1}]}];

We first try a standard export without fonts:

ExportEPS["test.eps", p, RemoveClip -> False, 
      IncludeFonts -> False]

To avoid that the label placed via Epilog is clipped, we have to use RemoveClip->True. Fonts are now included as well (this only works on Unix systems with emmathfnt installed and Mathematica up to version 4.1):

ExportEPS["test.eps", p, RemoveClip -> True, 
      IncludeFonts -> True]