EconGroup`EGPlotting

Code by Luci Ellis, based on template by Roman E. Maeder, Programming in Mathematica, 3rd Edition

This notebook forms the basis of a package for various special plot styles used in Economic Group.

Reference

Title

EGPlotting

Author

Luci B. Ellis

Summary

This notebook forms the basis of a package for various special plot styles used in Economic Group.

Copyright

© Copyright 1997, Economic Group, Reserve Bank of Australia.

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.2

Mathematica Version

3.0

History

Version 1.2: Fixed glitches in econstyle list of options causing it to fail for plots of continuous functions (as opposed to ListPlots). Now two versions, econstylelist and econstylefunction, which omits the PlotJoined->True option.Also 
Version 1.1: Converted Trumpet[] and econplot[] one version 3.0 format notebook.
Version 1.0: Original (version 2.2 format) EGPlotting package contained Trumpet[]; egPlot in a version 3.0 notebook but not yet a package.

Keywords

RBA “Board standard”, Confidence bands.

Source

Economic Group Board graph standards; Trumpet[] inspired by Bank of England work.

Warnings

description of global effects, incompatibilities

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["EGPlotting`"]. Cells not intended to belong to the package should not have this property.

Limitation

special cases not handled, known problems

Requirements

Statistics`DescriptiveStatistics`, Utilities`FilterOptions (hidden)

Setup

Interface

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

Set up the package context, including public imports

Needs["Statistics`DescriptiveStatistics`"]

BeginPackage["EconGroup`EGPlotting`", 
      "Statistics`DescriptiveStatistics`"]

Usage messages for the exported functions and the context itself

EGPlotting::usage = "EGPlotting.m implements Mathematica graphs that are close to Board Standard in format, and Trumpet graphs like the Bank of England uses."

econplot::usage = "econplot[data] implements Mathematica graphs that are close to Board Standard in format, but with a smaller font size as is appropriate for insertion into a note."

econstylelist::usage = "econstyle is a sequence of options suitable for insertion into ListPlot functions where the econplot[] command isn't appropriate for whatever reason. The Sequence must be wrapped in Evaluate to work."

econstylefunction::usage = "econstyle is a sequence of options suitable for insertion into Plot functions where the econplot[] command isn't appropriate for whatever reason. The Sequence must be wrapped in Evaluate to work."

plotheadingstyle::usage = "plotheadingstyle[x_String] binds the string x into a Plot option that creates a plot heading in 13-point Helvetica bold (the appropriate font for a Board-style graph in a note).The option must be wrapped in Evaluate to work."

Trumpet::usage = 
      "Trumpet[x] creates a Bank of England style *trumpet* graph, with a \
line for the median of the realisations of a series through time, and a grey \
trumpet defining the region covered by the middle two quartiles, where each \
set of realisations is stored as a sublist in the two-dimensional matrix x. \
Trumpet[x,l,h] creates a *trumpet* graph, with a line for the median \
realisation, and a grey trumpet between the low and high quantiles. The \
arguments l and h must be integers between 1 and 99."

Distsurface::usage = 
      "Distsurface[x,di] creates a histogram-surface of the realisations of \
a series through time, with divisions di in size, where each set of \
realisations is stored as a sublist in the two-dimensional matrix x."

quart::usage = 
      "quart[x] returns a 2N x 2 matrix of the row number and the \
boundaries of the upper and lower quartiles of the elements in that row. The \
upper quartile is in reverse row order."

Error messages for the exported objects

econplot::notnum = "Not all of the points in this data list are numerical quantities."

econplot::lablen = "List of graph labels does not have the same number of elements as there are series provided."

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`"]

Read in any hidden imports

Needs["Utilities`FilterOptions`"]

Definition of auxiliary functions and local (static) variables

realise[]; realiseit[]

realise[x_Integer] := N[x, 1]

realiseit[x_] := N[x, 10]

checkedpart[]

checkedpart[x_, q_] := 
      If[Round[0.01 q 
              Dimensions[x, 2][[2]]]
             == 0, 1, 
        Round[0.01 q 
            Dimensions[x, 2][[2]]]]

quart[]

quart[x_] := 
      Transpose[
        Join[Table[{realise[i], 
              Sort[Flatten[x[[i]]]]
                  [[checkedpart[x, 25]
                  ]]}, {i, 1, 
              Dimensions[x][[1]]}], 
          Reverse[Table[{realise[i], 
                Sort[Flatten[x[[i]]]]
                    [[Round[
                    0.75 Dimensions[x, 2][[2
                        ]]]]]}, {i, 1, 
                Dimensions[x][[1
                  ]]}]]]]

quart[x_, l_Integer, h_Integer] := 
      Transpose[
        Join[Table[{realise[i], 
              Sort[Flatten[x[[i]]]]
                  [[checkedpart[x, l]
                  ]]}, {i, 1, 
              Dimensions[x][[1]]}], 
          Reverse[Table[{realise[i], 
                Sort[Flatten[x[[i]]]]
                    [[Round[
                    0.01 h 
                      Dimensions[x, 2][[2
                        ]]]]]}, {i, 1, 
                Dimensions[x][[1
                  ]]}]]]]

egmean[]

egmean[x_]:=Table[{i,realiseit[Sum[x[[i]][[j]],{j,1,Dimensions[x][[2]]}]/(Dimensions[x][[2]] )]}, {i,1,Part[Dimensions[x],1]}]

Histoset[]

histoset[x_, di_] := 
      Table[Count[x[[j]], 
          True /; Chop[x[[j]]/di] = 
            (i/di)], {j, 1, Dimensions[x, 1]}, {i, Floor[Min[x]], 
          Ceiling[Max[x]], di}]

Definition of the exported functions

econstylelist  =  
      Sequence[PlotJoined -> True, Frame -> True, 
        AspectRatio -> (14/19), Ticks -> None, 
        FrameTicks -> {Automatic, Automatic, None, None}, 
        DefaultFont :> {"Helvetica", 11}, 
        PlotRange -> All, 
        GridLines -> {None, {Automatic, GrayLevel[0.7]}}]

econstylefunction  =  
      Sequence[Frame -> True, AspectRatio -> (14/19), 
        Ticks -> None, 
        FrameTicks -> {Automatic, Automatic, None, None}, 
        DefaultFont :> {"Helvetica", 11}, 
        PlotRange -> All, 
        GridLines -> {None, {Automatic, GrayLevel[0.7]}}]

plotheadingstyle[x_String] := 
      PlotLabel -> 
        StyleForm[x, FontFamily -> "Helvetica",  
          FontSize -> 13, FontWeight -> "Bold"]

Trumpet[]

Trumpet[x_List, opts___?OptionQ] := 
      Block[{a, b}, 
        a = Graphics[{GrayLevel[0.7], Polygon[Transpose[quart[x]]]}]; 
        b = ListPlot[egmean[x], PlotJoined -> True, 
            DisplayFunction -> Identity, FilterOptions[ListPlot, opts]]; 
        Show[{a, b}, AspectRatio -> 1, Frame -> True, 
          DisplayFunction -> $DisplayFunction], 
        FilterOptions[Graphics, opts]]

Trumpet[x_List, l_Integer, h_Integer, opts___?OptionQ] := 
      Block[{a, b}, 
        a = Graphics[{GrayLevel[0.7], Polygon[Transpose[quart[x, l, h]]]}]; 
        b = ListPlot[egmean[x], PlotJoined -> True, 
            DisplayFunction -> Identity, FilterOptions[ListPlot, opts]]; 
        Show[{a, b}, AspectRatio -> 1, Frame -> True, 
          DisplayFunction -> $DisplayFunction, 
          FilterOptions[Graphics, opts]]]

Distsurface[]

Distsurface[x_, di_] := 
      ListPlot3D[histoset[x, di], ColorFunction -> Hue]

econplot[]

Options[econplot] = {ArrayStyle -> True}

\(econplot[data_?VectorQ, label_, opts___] := 
	
      If[And\ @@\ \((\(NumericQ[#]&\)\ /@\ data)\), 

        ListPlot[data, FilterOptions[ListPlot, opts], 
          PlotJoined -> True, Frame -> True, 
          PlotLabel -> 
            StyleForm[label, FontFamily -> "Helvetica", \ 
              FontSize -> 13, FontWeight -> "Bold"], 
          AspectRatio -> 14\/19, Ticks -> None, 
          FrameTicks -> {Automatic, Automatic, None, None}, 
          DefaultFont :> {"Helvetica", 11}, 
          PlotRange -> All, 
          GridLines -> {None, {Automatic, GrayLevel[0.7]}}], 
        Message[econplot::notnum]]\)

\(econplot[data_List, label_String, opts___] := 
	
      \(econplot[#1, label, opts]\ &\)\ /@\ data\)

\(econplot[data_List, label_?VectorQ, opts___] := 

      If[\(Dimensions[data]\)[[1]] 
          == Length[label], 
	
        Module[{howdone}, 
	
          howdone\  = \ 
            \(ArrayStyle\  /. {FilterOptions[econplot, opts]}\)\  /. 
              Options[econplot]; 
	
          If[howdone, 
	
            Show[GraphicsArray[
				
                Table[econplot[
                    data[[i]], 
                    label[[i]], 
                    DisplayFunction\  -> Identity, opts], {i, 1, 
                    Length[label]}]\ ], 
              DisplayFunction\  -> $DisplayFunction], 
				
            Show[Table[
                econplot[data[[i]], 
                  label[[i]], 
                  DisplayFunction\  -> Identity, opts], {i, 1, 
                  Length[label]}], 
              DisplayFunction\  -> $DisplayFunction]]], 
        Message[econplot::lablen]]\)

End the private context

End[ ]

Epilog

This section protects exported symbols and ends the package.

Protect exported symbol

Protect[Evaluate[$Context <> "*"]]

End the package context

EndPackage[ ]

Examples, Tests

Examples, tests for the use of the package can go here.