(*********************************************************************** This file was generated automatically by the Mathematica front end. It contains Initialization cells from a Notebook file, which typically will have the same name as this file except ending in ".nb" instead of ".m". This file is intended to be loaded into the Mathematica kernel using the package loading commands Get or Needs. Doing so is equivalent to using the Evaluate Initialization Cells menu command in the front end. DO NOT EDIT THIS FILE. This entire file is regenerated automatically each time the parent Notebook file is saved in the Mathematica front end. Any changes you make to this file will be overwritten. ***********************************************************************) BeginPackage["Graphics`EnhancedGraphics`", "Graphics`Graphics`", "Utilities`FilterOptions`"]; $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."; ExportEPS::notsupp = "The IncludeFonts and RemoveClip options are only supported on Unix systems! Use IncludeFonts->False and RemoveClip->False."; Begin["`Private`"]; protected = Unprotect[ ContourPlot ]; 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]) ] ]; checkTickNumbers[Automatic] := Automatic; checkTickNumbers[{x_Integer, y_Integer}] := If[x > 0 && y > 0, {x,y}, checkTickNumbers[]]; checkTickNumbers[_] := {8, 32}; trimDecimal[x_?VectorQ] := Map[If[Log[10.0, Abs[#]] < 5.0 && # == Round[#], Round[#], #, #]&, x] 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} ]; $LineStyle = AbsoluteThickness[0.5]; Attributes[Pt]={Listable}; Pt[cm_]:=(cm/2.54)*72; Pt[cm1_,cm2_]:={Pt[cm1],Pt[cm2]}; $FontsDirectory = $TopDirectory <> "/SystemFiles/Fonts/Type1/"; If[($OperatingSystem == "Unix") && ($VersionNumber < 4.2), Options[ExportEPS] = { IncludeFonts -> True, RemoveClip -> False, FontsDirectory :> $FontsDirectory }, Options[ExportEPS] = { IncludeFonts -> False, RemoveClip -> False, FontsDirectory :> $FontsDirectory } ]; 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[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]}; 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} ]; 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 ]; TicksOnly = TickFunction[#1, #2, TextFunction -> (Table["", {Length[#]}]&)]&; 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] ]; $ContourPlotActive = True; 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] ] ] ]; $TextStyle = {FontFamily -> "Helvetica", FontSize -> 10.0}; $FormatType = TraditionalForm; $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; $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} ]; 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} ]; SetOptions[ParametricPlot3D, Axes -> True, Boxed -> True, AxesStyle :> $LineStyle, BoxStyle :> $LineStyle, Ticks -> {TickFunction, TickFunction, TickFunction} ]; Begin["Graphics`Graphics`Private`"]; transformticks[tfun_, f_, scale_, flag_:False] := Composition[transformticks[#, f, scale]&, tfun[10^#1, 10^#2]&] transformticks[Automatic, fun_, _, flag_:False] := If[TrueQ[flag] && (fun =!= Automatic), Composition[striplabels, fun], fun] End[ ]; 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} ]; Protect[ Evaluate[protected] ]; End[ ]; Protect[ Pt, ExportEPS, FontsDirectory, IncludeFonts, RemoveClip, TickFunction, TickPosition, TrimText, TicksOnly, TickLabels, TickNumbers, TextFunction, MajorLength, MajorStyle, MinorLength, MinorStyle ]; EndPackage[ ]