(*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 4.0, MathReader 4.0, or any compatible application. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. ***********************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 38257, 1233]*) (*NotebookOutlinePosition[ 39104, 1262]*) (* CellTagsIndexPosition[ 39060, 1258]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["StackedGraphicsArray", "Title", TextAlignment->Center], Cell["by Markus Lischka", "Subsubtitle", TextAlignment->Center], Cell["\<\ The StackedGraphicsArray package provides an extension to \ GraphicsArray. It generates an array of framed plots with \"shared\" axes and \ no spacing between the framed plots. Ticks and labels are preserved from the \ individual plots where possible.\ \>", "Text"], Cell[CellGroupData[{ Cell["Reference", "Section"], Cell[CellGroupData[{ Cell["Title", "Subsubsection"], Cell["\<\ StackedGraphicsArray.m \[LongDash] Graphics Array with \"Shared\" \ Axes\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Author", "Subsubsection"], Cell["Markus Lischka (mlischka@physik.tu-muenchen.de)", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Summary", "Subsubsection"], Cell["\<\ The StackedGraphicsArray package provides an extension to \ GraphicsArray. It generates an array of framed plots with \"shared\" axes and \ no spacing between the framed plots. Ticks and labels are preserved from the \ individual plots where possible.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Copyright", "Subsubsection"], Cell[TextData[{ "\[Copyright] Copyright 2000-2004, Markus Lischka.", StyleBox["\n\n", FontSlant->"Italic"], "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." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Notebook Version", "Subsubsection"], Cell["2.1", "Text"] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " Version" }], "Subsubsection"], Cell["4.0, 5.0", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["History", "Subsubsection"], Cell[TextData[{ "Version 1.0: Initial version (2000-07-21).\n\nVersion 1.1: Added handling \ of ", StyleBox["None", "Input"], " symbols representing empty plots (2000-08-18).\n\nVersion 1.2: Epilog \ options of single plots are now preserved (2001-02-15).\n\nVersion 1.3: Fixed \ bug when using ", StyleBox["StackedLabel", "Input"], " option: Vector layout was ignored (2002-07-22).\n\nVersion 1.4: ", StyleBox["RotateLabel", "Input"], " option is no longer ignored (2002-07-24).\n\nVersion 1.5: Initial \ submission to ", StyleBox["MathSource", FontSlant->"Italic"], " (2003-03-24).\n\nVersion 1.6: Replaced ", StyleBox["FullOptions", "Input"], " by ", StyleBox["AbsoluteOptions", "Input"], " (supersedes ", StyleBox["FullOptions", "Input"], " starting with ", StyleBox["Mathematica", FontSlant->"Italic"], " 4.0). Fixed two bugs reported by Derrick Bass: plots generated with ", StyleBox["PlotRange -> All", "Input"], " and plots having tick marks outside the plot range are now handled \ correctly; see ", StyleBox["filterTicksInPlotRange", "Input"], " (2003-04-27)\n\nVersion 2.0: Major rewrite to make the package compatible \ with ", StyleBox["Mathematica", FontSlant->"Italic"], " 5.0: the plots are now arranged directly using ", StyleBox["Rectangle", "Input"], " instead of using ", StyleBox["GraphicsArray", "Input"], " and the tick labels are placed in one single step after composition using \ ", StyleBox["PlotRange -> All", "Input"], " to avoid any clipping. For backwards compatibility, the option ", StyleBox["CompositionMode -> 1", "Input"], " was added. Furthermore, plots with different aspect ratios are now set to \ one common aspect ratio to avoid any misalignments (2003-09-24)\n\nVersion \ 2.1: Fixed a bug reported by Dale Horton (Omega Consulting) in ", StyleBox["addFrameLabelsScaled", "Input"], " and ", StyleBox["addFrameLabels", "Input"], ": Plots with single frame labels set to ", StyleBox["None", "Input"], " (such as ", StyleBox["FrameLabel -> {x, y, z, None}", "Input"], ") are now plotted correctly. In previous versions, a text label \"{}\" was \ erroneously added to the plot (2004-10-11)" }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Keywords", "Subsubsection"], Cell["GraphicsArray, multiple plots, stacked plots", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Source", "Subsubsection"], Cell[TextData[{ "Michele Cappellari, ", StyleBox["Graphics`MongoArray` package", FontSlant->"Italic"], " (", StyleBox["MathSource", FontSlant->"Italic"], " #0208-538", StyleBox[", ", FontWeight->"Bold"], ButtonBox["http://library.wolfram.com/infocenter/MathSource/717", ButtonData:>{ URL[ "http://library.wolfram.com/infocenter/MathSource/717"], None}, ButtonStyle->"Hyperlink"], ")\nRoman E. Maeder. ", StyleBox["Programming in Mathematica", FontSlant->"Italic"], ", 3rd ed. Addison-Wesley, 1996." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Warnings", "Subsubsection"], Cell[TextData[{ "Tick marks generated automatically might need to be adjusted so that they \ do not overlap. Resizing the final graphics often helps as the font size is \ fixed.\n\nDependent on the setting of ", StyleBox["CompositionMode", "Input"], ", ", StyleBox["StackedGraphicsArray ", "Input"], "either returns a ", StyleBox["Graphics", "Input"], " object (", StyleBox["CompositionMode -> 2", "Input"], ") or a ", StyleBox["GraphicsArray", "Input"], " object (", StyleBox["CompositionMode -> 1", "Input"], ", deprecated). Be aware that graphics created with ", StyleBox["CompositionMode -> 1", "Input"], " are not properly rendered in ", StyleBox["Mathematica", FontSlant->"Italic"], " 5.0.\n\nPlots need to be plotted with ", StyleBox["Frame->True", "Input"], " as ", StyleBox["StackedGraphicsArray", "Input"], " uses ", StyleBox["FrameTicks", "Input"], " to determine the labels of the combined plot." }], "Text"], Cell[TextData[{ "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 \ ", StyleBox["Needs[\"Template`\"]", "Input"], ". Cells not intended to belong to the package should not have this \ property." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Limitations", "Subsubsection"], Cell[TextData[{ "The labels of the combined graphics are plotted via the Epilog option. \ Otherwise, a combination with zero spacing would not be possible. \n\nWhen \ using ", StyleBox["CompositionMode -> 1", "Input"], ", i.e., the technique of version 1.x of this package, this implies that\n\ (1) PlotRegion has to be extended (by default to {{0.15,0.85}, {0.15,0.85}}) \ to avoid cutting off the labels and\n(2) exporting EPS will not work \ correctly due to inconsistent EPS rendering in ", StyleBox["Mathematica", FontSlant->"Italic"], " (at least in versions up to 4.x) as the labels will be clipped. Removing \ all lines that contain the single PostScript command \"clip\", e.g. by \"sed \ -e 's/^clip$//' plot.eps > plot2.eps\", solves this problem. Using the \ default ", StyleBox["CompositionMode -> 2", "Input"], " avoids these problems.\n\nThe front end of ", StyleBox["Mathematica", FontSlant->"Italic"], " 5.0 correctly clips any displayed graphics consistently with its EPS \ export feature. For ", StyleBox["Mathematica", FontSlant->"Italic"], " 5.0, ", StyleBox["CompositionMode -> 1", "Input"], " thus does not work for displaying graphics in ", StyleBox["Mathematica", FontSlant->"Italic"], "'s front end." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Discussion", "Subsubsection"], Cell[TextData[{ "The idea of placing the labels via the Epilog option is taken from ", StyleBox["Graphics`MongoArray`", "Input"], ". Look at that package for a different implementation of a stacked \ graphics array." }], "Text"], Cell[TextData[{ "When combining multiple graphics into a graphics array, tick labels of the \ individual plots might overlap. For easy manipulation of tick labels see \ Elizabeth Praton's package ", StyleBox["Graphics`TickControl`", "Input"], " (", ButtonBox["http://library.wolfram.com/infocenter/MathSource/5217", ButtonData:>{ URL[ "http://library.wolfram.com/infocenter/MathSource/5217"], None}, ButtonStyle->"Hyperlink"], "). The accompanying guide includes an introduction on how to use both \ packages together." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Requirements", "Subsubsection"], Cell[TextData[StyleBox["Utilities`FilterOptions`", "Input"]], "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Interface", "Section", InitializationCell->True], Cell["\<\ This part declares the publicly visible functions, options, and \ values.\ \>", "Text", InitializationCell->True], Cell[CellGroupData[{ Cell["Set up the package context, including public imports", "Subsection", InitializationCell->True], Cell["\<\ BeginPackage[\"Graphics`StackedGraphicsArray`\", \ \"Utilities`FilterOptions`\"]\ \>", "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell["\<\ Usage messages for the exported functions and the context \ itself\ \>", "Subsection", InitializationCell->True], Cell["\<\ StackedGraphicsArray::usage = \"StackedGraphicsArray[{g1, g2, ... \ }] represents a row of graphics objects. StackdGraphicsArray[{{g11, g12, ... \ }, ... }] represents a two-dimensional array of graphics objects. The objects \ are combined with zero spacing between the graphics frames such that they \ \\\"share\\\" their axes, and interior labels are removed. The placement of \ labels can be controlled by the option StackedLabel.\";\ \>", "Input", InitializationCell->True], Cell["\<\ StackedLabel::usage = \"StackedLabel is an option for \ StackedGraphicsArray that specifies which single plot labels should be \ removed. The default value Automatic removes all interior labels of the \ graphics array. Alternatively, it can be a list of the same form as the \ Graphics array to be processed. Each entry has to be a four-element list that \ specifies which labels should be suppressed (None) and which not (Automatic).\ \";\ \>", "Input", InitializationCell->True], Cell["\<\ CompositionMode::usage = \"CompositionMode is an option for \ StackedGraphicsArray that specifies which composition technique to use for \ the graphics array. Valid choices for CompositionMode are 1 and 2. The \ default and recommended value is CompositionMode -> 2. The setting \ CompositionMode -> 1 uses the technique of version 1.x of the \ StackedGraphicsArray package. It is provided for backwards compatibility and \ might be removed in future versions as it is no longer compatible with \ Mathematica 5.0. Its use is strongly discouraged.\";\ \>", "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell["Error messages for the exported objects", "Subsection", InitializationCell->True], Cell["\<\ StackedGraphicsArray::labels = \"Dimensions of GraphicsArray and \ StackedLabel are incompatible.\";\ \>", "Input", InitializationCell->True], Cell["\<\ StackedGraphicsArray::arrsp = \"Value of option GraphicsSpacing -> \ `1` should be a number equal or greater than 0 or a list of two such numbers; substituting 0 \ instead.\";\ \>", "Input", InitializationCell->True], Cell["\<\ StackedGraphicsArray::aspr = \"Warning: Aspect ratios of the given \ plots are not identical. The aspect ratio of the first plot, `1`, will \ override all other settings.\";\ \>", "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Implementation", "Section", InitializationCell->True], Cell["\<\ This part contains the actual definitions and any auxiliary \ functions that should not be visible outside.\ \>", "Text"], Cell[CellGroupData[{ Cell["Begin the private context (implementation part)", "Subsection", InitializationCell->True], Cell["Begin[\"`Private`\"]", "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell["\<\ Definition of auxiliary functions and local (static) \ variables\ \>", "Subsection", InitializationCell->True], Cell[CellGroupData[{ Cell[TextData[StyleBox["arraySpacing[]", "Input"]], "Subsubsection", InitializationCell->True], Cell[TextData[{ "Determine horizontal and vertical array spacing. The value of the ", StyleBox["GraphicsSpacing", "Input"], " option should be a\nnumber equal or greater than 0 or a list of two such \ numbers:" }], "Text"], Cell["\<\ arraySpacing[spacing_] := (Message[StackedGraphicsArray::arrsp, \ spacing]; {0, 0})\ \>", "Input", InitializationCell->True], Cell["arraySpacing[spacing_?(# >= 0 &)] := {spacing, spacing};", "Input", InitializationCell->True], Cell["\<\ arraySpacing[spacing:{hsp_?(# >= 0 &), vsp_?(# >= 0 &)}] := \ spacing;\ \>", "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[StyleBox["defaultTickLabels[]", "Input"]], "Subsubsection", InitializationCell->True], Cell[TextData[{ "Create two-dimensional array with elements ", StyleBox["{bottom,left,top,right}", "Input"], " where each element is either ", StyleBox["None", "Input"], " (labels to be removed) or ", StyleBox["Automatic", "Input"], " (labels to be kept):" }], "Text"], Cell["\<\ defaultTickLabels[plots_?VectorQ, spacing_] := First[defaultTickLabels[{plots}, spacing]];\ \>", "Input", InitializationCell->True], Cell["\<\ defaultTickLabels[plots_?MatrixQ, spacing_] := Module[{dim, ft, s}, dim = Dimensions[plots]; ft = Table[Automatic, {dim[[1]]}, {dim[[2]]}, {4}]; s = Flatten[{spacing}]; If[First[s] \[Equal] 0, Do[ft[[i, j, 2]] = None, {i, 1, dim[[1]]}, {j, 2, dim[[2]]}]; Do[ft[[i, j, 4]] = None, {i, 1, dim[[1]]}, {j, 1, dim[[2]]-1}]; ]; If[Last[s] \[Equal] 0, Do[ft[[i, j, 1]] = None, {i, 1, dim[[1]]-1}, {j, 1, dim[[2]]}]; Do[ft[[i, j, 3]] = None, {i, 2, dim[[1]]}, {j, 1, dim[[2]]}]; ]; ft ];\ \>", "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[StyleBox["determineAspectRatio[]", "Input"]], "Subsubsection", InitializationCell->True], Cell["\<\ Determine aspect ratio of the given plots. If the aspect ratio is \ not the same for all plots, a warning is issued.\ \>", "Text"], Cell["\<\ determineAspectRatio[plots_] := Module[{aspectRatios, aspectRatio}, aspectRatios = Flatten[ Map[ If[# =!= None, (AspectRatio /. AbsoluteOptions[#, AspectRatio]), Sequence[] ]&, plots, {2} ] ]; aspectRatio = First[aspectRatios]; If[!(Equal @@ aspectRatios), Message[StackedGraphicsArray::aspr, aspectRatio] ]; aspectRatio ];\ \>", "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[StyleBox["removeTickLabels[]", "Input"]], "Subsubsection", InitializationCell->True], Cell["Remove tick labels, but keep the actual tick marks:", "Text"], Cell["removeTickLabels[None] := {};", "Input", InitializationCell->True], Cell["\<\ removeTickLabels[plot_] := FrameTicks /. AbsoluteOptions[plot, FrameTicks] /. {a_Real, b_, c_, d_} -> {a, \"\", c, d};\ \>", "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[StyleBox["extractCorePlotRegion[]", "Input"]], "Subsubsection", InitializationCell->True], Cell[TextData[{ "This function extracts the \"bare\" plotting region with all labels \ stripped. Empty slots in the graphics array are represented by the symbol ", StyleBox["None", "Input"], " and are ignored." }], "Text"], Cell[TextData[{ "Before composing the Graphics objects, the plot range of each individual \ plot has to be changed to an absolute setting. Otherwise, ", StyleBox["PlotRange -> All", "Input"], " will cause the plot to be scaled down as any ", StyleBox["Epilog", "Input"], " primitives are also taken into account before rendering the plot." }], "Text"], Cell["extractCorePlotRegion[None, aspr_] := None;", "Input", InitializationCell->True], Cell["\<\ extractCorePlotRegion[plot_, aspr_] := Show[plot, DisplayFunction -> Identity, PlotLabel -> None, Frame -> True, FrameLabel -> None, FrameTicks -> removeTickLabels[plot], AbsoluteOptions[plot, PlotRange], AspectRatio -> aspr ];\ \>", "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[StyleBox["computeBoundingBox[]", "Input"]], "Subsubsection", InitializationCell->True], Cell[TextData[{ "This function computes the lower left and upper right corner of the plot \ at position ", StyleBox["{xi, yi}", "Input"], ":" }], "Text"], Cell["\<\ computeBoundingBox[{xi_, yi_}, {hsp_, vsp_}, aspr_] := {{xi * (1+hsp), (-yi * (1+vsp)) * aspr}, {xi * (1+hsp) + 1, (-yi * (1+vsp) + 1) * aspr}};\ \>", "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[StyleBox["filterTicksInPlotRange[]", "Input"]], "Subsubsection", InitializationCell->True], Cell[TextData[{ "In special cases, ", StyleBox["Mathematica", FontSlant->"Italic"], " generates tick marks just outside the plot range (which are automatically \ removed when actually plotting the graphics object). To avoid any overlap of \ tick marks placed via ", StyleBox["Epilog", "Input"], " between neighbouring graphics objects, we discard these tick marks:" }], "Text"], Cell["\<\ filterTicksInPlotRange[ticks_List, {min_, max_}] := Select[ticks, ((#[[1]] >= min) && (#[[1]] <= max))&];\ \>", "Input", InitializationCell->True], Cell["\<\ filterTicksInPlotRange[plot_] := Module[{ticks, xrange, yrange}, ticks = FrameTicks /. AbsoluteOptions[plot, FrameTicks]; {xrange, yrange} = PlotRange /. AbsoluteOptions[plot, PlotRange]; { filterTicksInPlotRange[ticks[[1]], xrange], filterTicksInPlotRange[ticks[[2]], yrange], filterTicksInPlotRange[ticks[[3]], xrange], filterTicksInPlotRange[ticks[[4]], yrange] } ]; \ \>", "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[StyleBox["addTickLabelsScaled[]", "Input"]], "Subsubsection", InitializationCell->True], Cell[TextData[{ "Add tick labels indirectly via Text primitives (for use with ", StyleBox["Epilog", "Input"], "):" }], "Text"], Cell["addTickLabelsScaled[None, region_, labels_] := Sequence[];", "Input", InitializationCell->True], Cell["\<\ addTickLabelsScaled[plot_, region:{{sxmin_, symin_}, {sxmax_, \ symax_}}, labels_]:= Module[{frameTickLabels, xmin, xmax, ymin, ymax, xr, yr}, frameTickLabels = filterTicksInPlotRange[plot]; frameTickLabels = Map[Select[#, (#[[2]] =!= \"\")&]&, \ frameTickLabels]; {{xmin, xmax}, {ymin, ymax}} = PlotRange /. AbsoluteOptions[plot, \ PlotRange]; xr = (sxmax - sxmin) / (xmax - xmin); yr = (symax - symin) / (ymax - ymin); frameTickLabels[[1]] = If[labels[[1]] === None, {}, Text[#[[2]], {(#[[1]] - xmin) * xr + sxmin, symin - 0.02}, \ {0, 1}]& /@ frameTickLabels[[1]]]; frameTickLabels[[2]] = If[labels[[2]] === None,{}, Text[#[[2]], {sxmin - 0.02, (#[[1]] - ymin) * yr + symin}, \ {1, 0}]& /@ frameTickLabels[[2]]]; frameTickLabels[[3]] = If[labels[[3]] === None, {}, Text[#[[2]], {(#[[1]] - xmin) * xr + sxmin, symax + 0.02}, \ {0, -1}]& /@ frameTickLabels[[3]]]; frameTickLabels[[4]] = If[labels[[4]] === None, {}, Text[#[[2]], {sxmax + 0.02, (#[[1]] - ymin) * yr + symin}, \ {-1, 0}]& /@ frameTickLabels[[4]]]; frameTickLabels ];\ \>", "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["addFrameLabelsScaled", "Input"], StyleBox["[]", "Input"] }], "Subsubsection", InitializationCell->True], Cell[TextData[{ "Add frame labels indirectly via Text primitives (for use with Epilog). The \ ", StyleBox["RotateLabel", "Input"], " option of each plot is used to decide how to place the vertical labels:" }], "Text"], Cell["addFrameLabelsScaled[None, region_, labels_] := Sequence[];", "Input", InitializationCell->True], Cell["\<\ addFrameLabelsScaled[plot_, region:{{sxmin_, symin_}, {sxmax_, \ symax_}}, labels_] := Module[{frameLabels, rotateLabels, sxd, syd}, frameLabels = FrameLabel /. AbsoluteOptions[plot, FrameLabel]; rotateLabels = RotateLabel /. AbsoluteOptions[plot, RotateLabel] /. \t{True -> {0,1}, _ -> Sequence[]}; sxd = (sxmax - sxmin); syd = (symax - symin); If[Length[frameLabels] =!= 2 && Length[frameLabels] =!= 4, frameLabels = {}, (* i.e., frameLabels === None *) If[Length[frameLabels] == 2 || Length[frameLabels] == 4, frameLabels[[1]] = If[(labels[[1]] === None) || (frameLabels[[1]] === None), \ {}, Text[frameLabels[[1]], {sxmin + 0.5 sxd, symin - 0.15 \ syd}, {0, 1}]]; frameLabels[[2]] = If[(labels[[2]] === None) || (frameLabels[[2]] === None), \ {}, Text[frameLabels[[2]], {sxmin - 0.15 sxd, symin + 0.5 \ syd}, {1, 0}, rotateLabels]]; ]; If[Length[frameLabels] == 4, frameLabels[[3]] = If[(labels[[3]] === None) || (frameLabels[[3]] === None), \ {}, Text[frameLabels[[3]], {sxmin + 0.5 sxd, symin + 1.15 \ syd}, {0, -1}]]; frameLabels[[4]] = If[(labels[[4]] === None) || (frameLabels[[4]] === None), \ {}, Text[frameLabels[[4]], {sxmin + 1.15 sxd, symin + 0.5 \ syd}, {-1, 0}, rotateLabels]]; ] ]; frameLabels ];\ \>", "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["addTickLabels[]", "Input"], " - deprecated" }], "Subsubsection", InitializationCell->True], Cell[TextData[{ "Add tick labels indirectly via Text primitives (for use with ", StyleBox["Epilog", "Input"], "). This function is only used by ", StyleBox["StackedGraphicsArray", "Input"], " when invoked with ", StyleBox["CompositionMode -> 1", "Input"], " and might be removed in future versions of this package:" }], "Text"], Cell["addTickLabels[None, labels_] := Sequence[];", "Input", InitializationCell->True], Cell["\<\ addTickLabels[plot_, labels_]:= Module[{frameTickLabels, xmin, xmax, ymin, ymax}, frameTickLabels = filterTicksInPlotRange[plot]; frameTickLabels = Map[Select[#, (#[[2]] =!= \"\")&]&, \ frameTickLabels]; {{xmin, xmax}, {ymin, ymax}} = PlotRange /. AbsoluteOptions[plot, \ PlotRange]; frameTickLabels[[1]] = If[labels[[1]] === None, {}, Text[#[[2]], Scaled[{0, -0.02}, {#[[1]], ymin}], {0, 1}]& /@ frameTickLabels[[1]]]; frameTickLabels[[2]] = If[labels[[2]] === None,{}, Text[#[[2]], Scaled[{-0.02, 0}, {xmin, #[[1]]}], {1, 0}]& /@ frameTickLabels[[2]]]; frameTickLabels[[3]] = If[labels[[3]] === None, {}, Text[#[[2]], Scaled[{0, 0.02}, {#[[1]], ymax}], {0, -1}]& /@ frameTickLabels[[3]]]; frameTickLabels[[4]] = If[labels[[4]] === None, {}, Text[#[[2]], Scaled[{0.02, 0}, {xmax, #[[1]]}], {-1, 0}]& /@ frameTickLabels[[4]]]; frameTickLabels ];\ \>", "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["addFrameLabels[]", "Input"], " ", "- deprecated" }], "Subsubsection", InitializationCell->True], Cell[TextData[{ "Add frame labels indirectly via Text primitives (for use with Epilog). The \ ", StyleBox["RotateLabel", "Input"], " option of each plot is used to decide how to place the vertical labels. \ This function is only used by ", StyleBox["StackedGraphicsArray", "Input"], " when invoked with ", StyleBox["CompositionMode -> 1", "Input"], " and might be removed in future versions of this package:" }], "Text"], Cell["addFrameLabels[None, labels_] := Sequence[];", "Input", InitializationCell->True], Cell["\<\ addFrameLabels[plot_, labels_] := Module[{frameLabels, rotateLabels}, frameLabels = FrameLabel /. AbsoluteOptions[plot, FrameLabel]; rotateLabels = RotateLabel /. AbsoluteOptions[plot, RotateLabel] /. {True -> {0,1}, _ -> Sequence[]}; If[Length[frameLabels] =!= 2 && Length[frameLabels] =!= 4, frameLabels = {}, (* frameLabels === None *) If[Length[frameLabels] == 2 || Length[frameLabels] == 4, frameLabels[[1]] = If[(labels[[1]] === None) || (frameLabels[[1]] === None), \ {}, Text[frameLabels[[1]], Scaled[{0.5, -0.15}], {0, \ 1}]]; frameLabels[[2]] = If[(labels[[2]] === None) || (frameLabels[[2]] === None), \ {}, Text[frameLabels[[2]], Scaled[{-0.15, 0.5}], {1, 0}, \ rotateLabels]]; ]; If[Length[frameLabels] == 4, frameLabels[[3]] = If[(labels[[3]] === None) || (frameLabels[[3]] === None), \ {}, Text[frameLabels[[3]], Scaled[{0.5, 1.15}], {0, \ -1}]]; frameLabels[[4]] = If[(labels[[4]] === None) || (frameLabels[[4]] === None), \ {}, Text[frameLabels[[4]], Scaled[{1.15, 0.5}], {-1, 0}, \ rotateLabels]]; ] ]; frameLabels ];\ \>", "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Definition of the exported functions", "Subsection", InitializationCell->True], Cell[CellGroupData[{ Cell[TextData[StyleBox["StackedGraphicsArray[]", "Input"]], "Subsubsection", InitializationCell->True], Cell["\<\ Options[StackedGraphicsArray] = Join[Options[GraphicsArray], {StackedLabel -> Automatic, CompositionMode \ -> 2}]; SetOptions[StackedGraphicsArray, GraphicsSpacing -> 0];\ \>", "Input", InitializationCell->True], Cell[TextData[{ "When calling ", StyleBox["StackedGraphicsArray[]", "Input"], " with just a vector of plots, all plots are drawn adjacent to each other \ (i.e., a matrix consisting of one single row). If the ", StyleBox["StackedLabel", "Input"], " option is given, it needs to be converted to the new matrix layout as \ well:" }], "Text"], Cell["\<\ StackedGraphicsArray[plots_?VectorQ, \topts1___?OptionQ, StackedLabel -> labels_?MatrixQ, opts2___?OptionQ] := \tStackedGraphicsArray[{plots}, opts1, StackedLabel -> {labels}, \ opts2];\ \>", "Input", InitializationCell->True], Cell["\<\ StackedGraphicsArray[plots_?VectorQ, opts___?OptionQ] := StackedGraphicsArray[{plots}, opts];\ \>", "Input", InitializationCell->True], Cell[TextData[{ "\"Empty slots\" are represented by the symbol ", StyleBox["None", "Input"], ". After composing the graphics array, ", StyleBox["Rectangle", "Input"], "s containing ", StyleBox["None", "Input"], " are replaced by empty lists to avoid any warnings." }], "Text"], Cell["\<\ StackedGraphicsArray[plots_, opts___?OptionQ] := Module[{hsp, vsp, labels, numx, numy, aspr, aspr2, plots2, bboxes}, {hsp, vsp} = arraySpacing[ GraphicsSpacing /. {opts} /. Options[StackedGraphicsArray]]; labels = StackedLabel /. {opts} /. Options[StackedGraphicsArray]; If[labels === Automatic, labels = defaultTickLabels[plots, {hsp, \ vsp}]]; If[Length[Dimensions[labels]] =!= 3 || Take[Dimensions[labels], 2] =!= Dimensions[plots], Message[StackedGraphicsArray::labels]; Return[$Failed] ]; {numy, numx} = Dimensions[plots]; aspr = determineAspectRatio[plots]; aspr2 = (numy + (numy - 1) * vsp) / (numx + (numx - 1) * hsp) * aspr; plots2 = Map[extractCorePlotRegion[#, aspr]&, plots, {2}]; bboxes = Table[ computeBoundingBox[{i, j}, {hsp, vsp}, aspr], {j, 0, numy-1}, {i, 0, numx-1} ]; Graphics[ MapThread[ Rectangle[Sequence @@ #2, #1]&, {plots2, bboxes}, 2] /. Rectangle[_, _, None] -> {}, Epilog -> { MapThread[ addTickLabelsScaled[#1, #2, #3]&, {plots, bboxes, labels}, 2], MapThread[ addFrameLabelsScaled[#1, #2, #3]&, {plots, bboxes, labels}, 2], Epilog /. {opts} /. (Epilog -> {}) }, FilterOptions[Graphics, opts], PlotRange -> All, AspectRatio -> aspr2 ] ];\ \>", "Input", InitializationCell->True], Cell[TextData[{ "The following function is provided for backwards compatibility with \ versions 1.x of the package. It is only used by ", StyleBox["StackedGraphicsArray", "Input"], " when invoked with ", StyleBox["CompositionMode -> 1", "Input"], " and might be removed in future versions of this package: Its use is \ strongly discouraged." }], "Text"], Cell["\<\ Implementation of \"empty slots\": To avoid any erroneous warnings, \ we use the following trick. The symbol None is first replaced by Graphics[ ] \ (at the top level only). MapThread then produces \"empty\" Graphics objects \ for these slots, i.e. a Graphics object containing only options. These \ option-only Graphics are then replaced by completely empty Graphics objects \ (otherwise Show issues warnings).\ \>", "Text"], Cell["\<\ StackedGraphicsArray[plots_, opts___?OptionQ] /; (CompositionMode == 1 /. {opts} /. Options[StackedGraphicsArray]) := Module[{spacing, labels, plots2, aspr}, spacing = GraphicsSpacing /. {opts} /. Options[StackedGraphicsArray]; labels = StackedLabel /. {opts} /. Options[StackedGraphicsArray]; If[labels === Automatic, labels = defaultTickLabels[plots, spacing]]; If[Length[Dimensions[labels]] =!= 3 || Take[Dimensions[labels], 2] =!= Dimensions[plots], Message[StackedGraphicsArray::labels]; Return[$Failed] ]; aspr = determineAspectRatio[plots]; plots2 = MapThread[ Show[Replace[#1, None -> Graphics[], {0}], DisplayFunction -> Identity, PlotLabel -> None, Frame -> True, FrameLabel -> None, FrameTicks -> removeTickLabels[#1], If[#1 =!= None, AbsoluteOptions[#1, PlotRange], PlotRange -> \ Automatic], AspectRatio -> aspr, Epilog -> {addTickLabels[#1, #2], addFrameLabels[#1, #2], Epilog /. Options[#1] /. (Epilog -> Sequence[])} ]&, {plots, labels}, 2]; GraphicsArray[plots2 /. Graphics[{___}] -> Graphics[{}], FilterOptions[GraphicsArray, opts], GraphicsSpacing -> spacing, PlotRegion -> {{0.15, 0.85}, {0.15, 0.85}}] ];\ \>", "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["End the private context", "Subsection", InitializationCell->True], Cell["End[ ]", "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Epilog", "Section", InitializationCell->True], Cell["This section protects exported symbols and ends the package.", "Text"], Cell[CellGroupData[{ Cell["Protect exported symbol", "Subsection", InitializationCell->True], Cell["Protect[Evaluate[$Context <> \"*\"]]", "Input", Evaluatable->False, InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell["End the package context", "Subsection", InitializationCell->True], Cell["EndPackage[ ]", "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Examples, Tests", "Section"], Cell[BoxData[ \(\(Needs["\"];\)\)], "Input"], Cell[BoxData[ \(\(p1 = Plot[Sin[x], {x, 0, 2\ Pi}, Frame \[Rule] True, FrameLabel \[Rule] {"\", "\"}, DisplayFunction \[Rule] Identity, Epilog \[Rule] {Text["\", {1.5 \[Pi], 0.5}]}];\)\)], "Input"], Cell[BoxData[ \(\(p2 = Plot[Sin[2\ x], {x, 0, 2\ Pi}, Frame \[Rule] True, FrameLabel \[Rule] {"\", \ "\"}, DisplayFunction \[Rule] Identity];\)\)], "Input"], Cell["\<\ Frame and tick labels might overlap unless the graphic size is \ increased :\ \>", "Text"], Cell[BoxData[ \(\(Show[StackedGraphicsArray[{p1, p2}], ImageSize \[Rule] 500];\)\)], "Input"], Cell[TextData[{ "The following statement will only work correctly up to ", StyleBox["Mathematica", FontSlant->"Italic"], " 4.2. The option ", StyleBox["CompositionMode \[Rule] 1", "Input"], " is provided for backwards compatibility and might be removed in future \ versions of this package:" }], "Text"], Cell[BoxData[ \(\(Show[ StackedGraphicsArray[{p1, p2}, \ CompositionMode\ \[Rule] \ 1]];\)\)], "Input"], Cell[BoxData[ \(\(Show[ StackedGraphicsArray[{{p1, p2}}, Epilog \[Rule] {Text["\", {1, 0.7}]}]];\)\)], "Input"], Cell[BoxData[ \(\(Show[ StackedGraphicsArray[{p1, p2}, StackedLabel \[Rule] {{None, Automatic, None, None}, {None, None, None, None}}]];\)\)], "Input"], Cell[BoxData[ \(\(Show[StackedGraphicsArray[{{p1}, {p2}}]];\)\)], "Input"], Cell[BoxData[ \(\(Show[ StackedGraphicsArray[{{p1}, {p2}}, StackedLabel \[Rule] {{{None, None, None, None}}, {{Automatic, None, None, None}}}]];\)\)], "Input"], Cell[BoxData[ \(\(Show[ StackedGraphicsArray[{{p1, p2, p1}, {p2, None, p2}}]];\)\)], "Input"], Cell[BoxData[ \(\(Show[ StackedGraphicsArray[{{p1, p2}, {p2, p1}}, GraphicsSpacing \[Rule] {0, 0.5}]];\)\)], "Input"], Cell[BoxData[ \(\(Show[ StackedGraphicsArray[{{p1, p2}, {p2, p1}}, GraphicsSpacing \[Rule] 0.5]];\)\)], "Input"], Cell[TextData[{ "Starting with version 1.6 of ", StyleBox["Graphics`StackedGraphicsArray`", "Input"], ", plots generated with ", StyleBox["PlotRange -> All", "Input"], " are handled correctly: " }], "Text"], Cell[BoxData[ \(\(p3 = Plot[Cos[x], \ {x, 0, 2\ Pi}, \ Frame \[Rule] True, PlotRange \[Rule] All, DisplayFunction \[Rule] Identity];\)\)], "Input"], Cell[BoxData[ \(\(Show[StackedGraphicsArray[{{p1}, {p3}}]];\)\)], "Input"], Cell["\<\ Plots with different aspect ratios are adjusted so that combined \ plots all have the same aspect ratio:\ \>", "Text"], Cell[BoxData[ \(\(p4 = Plot[Cos[2\ x], \ {x, 0, 2\ Pi}, \ Frame \[Rule] True, AspectRatio\ \[Rule] 1, DisplayFunction \[Rule] Identity];\)\)], "Input"], Cell[BoxData[ \(\(Show[StackedGraphicsArray[{p4, p3}]];\)\)], "Input"], Cell[TextData[{ "The following two plots test ", StyleBox["StackedGraphicsArray", "Input"], "'s capability to discard tick marks that are located outside of the plot \ range (", StyleBox["Mathematica", FontSlant->"Italic"], StyleBox[" 4.x", FontSlant->"Italic"], " generates a hidden tick mark at y = 1.25):" }], "Text"], Cell[BoxData[ \(\(p1 = Plot[Sin[x], \ {x, 0, 1}, \ Frame \[Rule] True, \ DisplayFunction \[Rule] Identity, PlotRange \[Rule] {\(-0.6251\), \ 1.2442}];\)\)], "Input"], Cell[BoxData[ \(\(p2 = Plot[Cos[x], \ {x, 0, 1}, \ Frame \[Rule] True, \ DisplayFunction \[Rule] Identity, PlotRange \[Rule] {\(-0.6251\), \ 1.2442}];\)\)], "Input"], Cell[BoxData[ \(\(Show[StackedGraphicsArray[{{p1}, {p2}}]];\)\)], "Input"] }, Open ]] }, Open ]] }, FrontEndVersion->"4.0 for X", ScreenRectangle->{{0, 1152}, {0, 864}}, AutoGeneratedPackage->Automatic, CellGrouping->Automatic, WindowSize->{774, 794}, WindowMargins->{{Automatic, 26}, {Automatic, 0}}, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, 128}}, ShowCellLabel->True, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False} ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1739, 51, 62, 1, 107, "Title"], Cell[1804, 54, 65, 1, 53, "Subsubtitle"], Cell[1872, 57, 275, 5, 50, "Text"], Cell[CellGroupData[{ Cell[2172, 66, 28, 0, 54, "Section"], Cell[CellGroupData[{ Cell[2225, 70, 30, 0, 42, "Subsubsection"], Cell[2258, 72, 96, 3, 32, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[2391, 80, 31, 0, 28, "Subsubsection"], Cell[2425, 82, 63, 0, 32, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[2525, 87, 32, 0, 28, "Subsubsection"], Cell[2560, 89, 275, 5, 50, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[2872, 99, 34, 0, 28, "Subsubsection"], Cell[2909, 101, 307, 7, 86, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[3253, 113, 41, 0, 28, "Subsubsection"], Cell[3297, 115, 19, 0, 32, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[3353, 120, 101, 4, 28, "Subsubsection"], Cell[3457, 126, 24, 0, 32, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[3518, 131, 32, 0, 28, "Subsubsection"], Cell[3553, 133, 2229, 53, 446, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[5819, 191, 33, 0, 28, "Subsubsection"], Cell[5855, 193, 60, 0, 32, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[5952, 198, 31, 0, 28, "Subsubsection"], Cell[5986, 200, 560, 18, 50, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[6583, 223, 33, 0, 28, "Subsubsection"], Cell[6619, 225, 970, 27, 176, "Text"], Cell[7592, 254, 315, 7, 50, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[7944, 266, 36, 0, 28, "Subsubsection"], Cell[7983, 268, 1283, 29, 194, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[9303, 302, 35, 0, 28, "Subsubsection"], Cell[9341, 304, 234, 5, 50, "Text"], Cell[9578, 311, 555, 12, 68, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[10170, 328, 37, 0, 28, "Subsubsection"], Cell[10210, 330, 69, 0, 31, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[10328, 336, 56, 1, 34, "Section", InitializationCell->True], Cell[10387, 339, 125, 4, 32, "Text", InitializationCell->True], Cell[CellGroupData[{ Cell[10537, 347, 102, 1, 45, "Subsection", InitializationCell->True], Cell[10642, 350, 133, 4, 27, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[10812, 359, 124, 4, 29, "Subsection", InitializationCell->True], Cell[10939, 365, 489, 8, 87, "Input", InitializationCell->True], Cell[11431, 375, 492, 9, 87, "Input", InitializationCell->True], Cell[11926, 386, 602, 10, 102, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[12565, 401, 89, 1, 29, "Subsection", InitializationCell->True], Cell[12657, 404, 153, 4, 42, "Input", InitializationCell->True], Cell[12813, 410, 228, 6, 42, "Input", InitializationCell->True], Cell[13044, 418, 226, 5, 42, "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[13319, 429, 61, 1, 34, "Section", InitializationCell->True], Cell[13383, 432, 131, 3, 32, "Text"], Cell[CellGroupData[{ Cell[13539, 439, 97, 1, 45, "Subsection", InitializationCell->True], Cell[13639, 442, 65, 1, 27, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[13741, 448, 122, 4, 29, "Subsection", InitializationCell->True], Cell[CellGroupData[{ Cell[13888, 456, 96, 1, 41, "Subsubsection", InitializationCell->True], Cell[13987, 459, 228, 5, 50, "Text"], Cell[14218, 466, 136, 4, 27, "Input", InitializationCell->True], Cell[14357, 472, 101, 1, 27, "Input", InitializationCell->True], Cell[14461, 475, 123, 4, 27, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[14621, 484, 101, 1, 27, "Subsubsection", InitializationCell->True], Cell[14725, 487, 282, 8, 50, "Text"], Cell[15010, 497, 148, 4, 42, "Input", InitializationCell->True], Cell[15161, 503, 652, 17, 237, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[15850, 525, 104, 1, 27, "Subsubsection", InitializationCell->True], Cell[15957, 528, 140, 3, 32, "Text"], Cell[16100, 533, 556, 19, 267, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[16693, 557, 100, 1, 27, "Subsubsection", InitializationCell->True], Cell[16796, 560, 67, 0, 32, "Text"], Cell[16866, 562, 74, 1, 27, "Input", InitializationCell->True], Cell[16943, 565, 183, 5, 57, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[17163, 575, 105, 1, 27, "Subsubsection", InitializationCell->True], Cell[17271, 578, 228, 5, 50, "Text"], Cell[17502, 585, 361, 7, 68, "Text"], Cell[17866, 594, 88, 1, 27, "Input", InitializationCell->True], Cell[17957, 597, 328, 10, 132, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[18322, 612, 102, 1, 27, "Subsubsection", InitializationCell->True], Cell[18427, 615, 159, 5, 32, "Text"], Cell[18589, 622, 211, 5, 57, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[18837, 632, 106, 1, 27, "Subsubsection", InitializationCell->True], Cell[18946, 635, 391, 9, 68, "Text"], Cell[19340, 646, 162, 4, 42, "Input", InitializationCell->True], Cell[19505, 652, 514, 13, 177, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[20056, 670, 103, 1, 27, "Subsubsection", InitializationCell->True], Cell[20162, 673, 132, 4, 32, "Text"], Cell[20297, 679, 103, 1, 27, "Input", InitializationCell->True], Cell[20403, 682, 1376, 37, 432, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[21816, 724, 135, 4, 27, "Subsubsection", InitializationCell->True], Cell[21954, 730, 223, 5, 50, "Text"], Cell[22180, 737, 104, 1, 27, "Input", InitializationCell->True], Cell[22287, 740, 1706, 43, 492, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[24030, 788, 122, 4, 28, "Subsubsection", InitializationCell->True], Cell[24155, 794, 341, 8, 50, "Text"], Cell[24499, 804, 88, 1, 27, "Input", InitializationCell->True], Cell[24590, 807, 1162, 27, 357, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[25789, 839, 129, 5, 28, "Subsubsection", InitializationCell->True], Cell[25921, 846, 434, 10, 68, "Text"], Cell[26358, 858, 89, 1, 27, "Input", InitializationCell->True], Cell[26450, 861, 1449, 36, 402, "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[27948, 903, 86, 1, 29, "Subsection", InitializationCell->True], Cell[CellGroupData[{ Cell[28059, 908, 104, 1, 41, "Subsubsection", InitializationCell->True], Cell[28166, 911, 227, 6, 57, "Input", InitializationCell->True], Cell[28396, 919, 348, 8, 50, "Text"], Cell[28747, 929, 243, 6, 57, "Input", InitializationCell->True], Cell[28993, 937, 150, 4, 42, "Input", InitializationCell->True], Cell[29146, 943, 290, 8, 50, "Text"], Cell[29439, 953, 1658, 44, 627, "Input", InitializationCell->True], Cell[31100, 999, 363, 8, 68, "Text"], Cell[31466, 1009, 435, 7, 86, "Text"], Cell[31904, 1018, 1505, 34, 477, "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[33458, 1058, 73, 1, 29, "Subsection", InitializationCell->True], Cell[33534, 1061, 51, 1, 27, "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[33634, 1068, 53, 1, 34, "Section", InitializationCell->True], Cell[33690, 1071, 76, 0, 32, "Text"], Cell[CellGroupData[{ Cell[33791, 1075, 73, 1, 45, "Subsection", InitializationCell->True], Cell[33867, 1078, 103, 2, 27, "Input", Evaluatable->False, InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[34007, 1085, 73, 1, 29, "Subsection", InitializationCell->True], Cell[34083, 1088, 58, 1, 27, "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[34190, 1095, 34, 0, 34, "Section"], Cell[34227, 1097, 81, 1, 27, "Input"], Cell[34311, 1100, 285, 6, 43, "Input"], Cell[34599, 1108, 204, 4, 43, "Input"], Cell[34806, 1114, 100, 3, 32, "Text"], Cell[34909, 1119, 106, 2, 27, "Input"], Cell[35018, 1123, 318, 8, 50, "Text"], Cell[35339, 1133, 127, 3, 27, "Input"], Cell[35469, 1138, 179, 4, 27, "Input"], Cell[35651, 1144, 191, 4, 43, "Input"], Cell[35845, 1150, 78, 1, 27, "Input"], Cell[35926, 1153, 201, 4, 43, "Input"], Cell[36130, 1159, 105, 2, 27, "Input"], Cell[36238, 1163, 140, 3, 27, "Input"], Cell[36381, 1168, 135, 3, 27, "Input"], Cell[36519, 1173, 216, 6, 32, "Text"], Cell[36738, 1181, 182, 4, 27, "Input"], Cell[36923, 1187, 78, 1, 27, "Input"], Cell[37004, 1190, 128, 3, 32, "Text"], Cell[37135, 1195, 187, 4, 27, "Input"], Cell[37325, 1201, 74, 1, 27, "Input"], Cell[37402, 1204, 340, 10, 50, "Text"], Cell[37745, 1216, 200, 4, 43, "Input"], Cell[37948, 1222, 200, 4, 43, "Input"], Cell[38151, 1228, 78, 1, 27, "Input"] }, Open ]] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)