It is very easy to make this chart in Excel 2010, but it involves countless number of clicks and formulas to format both the source data and the chart itself.

In ggplot2 the same can be achieved with around 10 lines of code, as can be seen below.

Set up dummy dataframe

> set.seed(9876)
> DF <- data.frame(variable = 1:10, value = sample(10,
+     replace = TRUE))
> DF
   variable value
1         1     9
2         2     4
3         3     2
4         4     6
5         5     5
6         6     3
7         7     5
8         8     7
9         9     6
10       10     2

Prepare the charts

> library(ggplot2)

Dougnut chart is essentially a bar chart using a polar coordinate system, so we start off with a simple bar chart. And to make life a bit more colourful will fill each slice with a different colour.

> ggplot(DF, aes(factor(variable), value, fill = factor(variable))) +
+     geom_bar(width = 1)

Next the coordinate system is changed and some of the plot elements are removed for a cleaner look.

> last_plot() + scale_y_continuous(breaks = 0:10) +
+     coord_polar() + labs(x = "", y = "") + opts(legend.position = "none",
+     axis.text.x = theme_blank(), axis.text.y = theme_blank(),
+     axis.ticks = theme_blank())

Adding gridlines

Update 17 August 2010

Several commentators asked how to draw gridlines on top of the slices as in the original example.

Putting the gridlines/guides on top of the plot is accomplished by adding a new variable that is purely used for drawing the borders of each slice element. Essentially, it stacks the required number of slices with a white border on top of each other.

> DF <- ddply(DF, .(variable), transform, border = rep(1,
+     value))
> head(DF, 10)
   variable value border
1         1     9      1
2         1     9      1
3         1     9      1
4         1     9      1
5         1     9      1
6         1     9      1
7         1     9      1
8         1     9      1
9         1     9      1
10        2     4      1

> ggplot(DF, aes(factor(variable))) + geom_bar(width = 1,
+     aes(y = value, fill = factor(variable))) +
+     geom_bar(aes(y = border, width = 1), position = "stack",
+         stat = "identity", fill = NA, colour = "white") +
+     scale_y_continuous(breaks = 0:10) + coord_polar() +
+     labs(x = "", y = "") + opts(legend.position = "none",
+     axis.text.x = theme_blank(), axis.text.y = theme_blank(),
+     axis.ticks = theme_blank())

In the next few paragraphs I will show how to plot a waterfall chart using ggplot2.

Data

A very small fictional dataset depicting the changes to a company cash position, found in a blogpost showing how to prepare a waterfall chart in Tableau.

> balance <- data.frame(desc = c("Starting Cash",
+     "Sales", "Refunds", "Payouts", "Court Losses",
+     "Court Wins", "Contracts", "End Cash"), amount = c(2000,
+     3400, -1100, -100, -6600, 3800, 1400, 2800))
> balance
           desc amount
1 Starting Cash   2000
2         Sales   3400
3       Refunds  -1100
4       Payouts   -100
5  Court Losses  -6600
6    Court Wins   3800
7     Contracts   1400
8      End Cash   2800

In order to preserve the order of the lines in a dataframe I convert the desc variable to a factor; id and type variable are also added:

> balance$desc <- factor(balance$desc, levels = balance$desc)
> balance$id <- seq_along(balance$amount)
> balance$type <- ifelse(balance$amount > 0, "in",
+     "out")
> balance[balance$desc %in% c("Starting Cash", "End Cash"),
+     "type"] <- "net"

Next the data will be slightly reworked to specify the coordinates for drawing the waterfall bars.

> balance$end <- cumsum(balance$amount)
> balance$end <- c(head(balance$end, -1), 0)
> balance$start <- c(0, head(balance$end, -1))
> balance <- balance[, c(3, 1, 4, 6, 5, 2)]
> balance
  id          desc type start   end amount
1  1 Starting Cash  net     0  2000   2000
2  2         Sales   in  2000  5400   3400
3  3       Refunds  out  5400  4300  -1100
4  4       Payouts  out  4300  4200   -100
5  5  Court Losses  out  4200 -2400  -6600
6  6    Court Wins   in -2400  1400   3800
7  7     Contracts   in  1400  2800   1400
8  8      End Cash  net  2800     0   2800

Plotting

Now everything is set to plot the first waterfall chart. geom_rect is used to draw the rectangles using the coordinates calculated in the previous step.

> library(ggplot2)

> ggplot(balance, aes(desc, fill = type)) + geom_rect(aes(x = desc,
+     xmin = id - 0.45, xmax = id + 0.45, ymin = end,
+     ymax = start))

The fill mapping could use some tweaking (my preference is to have outflows in red, inflows in green, and net position in blue), for that I change the order of the underlying factor levels.

> balance$type <- factor(balance$type, levels = c("out",
+     "in", "net"))

Almost ready, one more tweak to the x-axis labels: the helper function below replaces spaces with new lines, making the labels more readable.

> strwr <- function(str) gsub(" ", "\n", str)

> (p1 <- ggplot(balance, aes(fill = type)) + geom_rect(aes(x = desc,
+     xmin = id - 0.45, xmax = id + 0.45, ymin = end,
+     ymax = start)) + scale_y_continuous("", formatter = "comma") +
+     scale_x_discrete("", breaks = levels(balance$desc),
+         labels = strwr(levels(balance$desc))) +
+     opts(legend.position = "none"))

Finally, the bar labels are also added (the conditional positioning of them is quite a lengthy process, as you can see).

> p1 + geom_text(subset = .(type == "in"), aes(id,
+     end, label = comma(amount)), vjust = 1, size = 3) +
+     geom_text(subset = .(type == "out"), aes(id,
+         end, label = comma(amount)), vjust = -0.3,
+         size = 3) + geom_text(data = subset(balance,
+     type == "net" & id == min(id)), aes(id, end,
+     colour = type, label = comma(end), vjust = ifelse(end <
+         start, 1, -0.3)), size = 3.5) + geom_text(data = subset(balance,
+     type == "net" & id == max(id)), aes(id, start,
+     colour = type, label = comma(start), vjust = ifelse(end <
+         start, -0.3, 1)), size = 3.5)

While these two questions seem to be related, in fact they are separate as the legend is controlled by scales, whereas stacking is controlled by the order of values in the data.

Recently I spent some time getting my head around this, and below is a quick recap.

Changing the Ordering of Legend Labels

The standard stacked barplot looks like this:

> library(ggplot2)

> ggplot(diamonds, aes(clarity, fill = cut)) + geom_bar()

You notice that in the legend “Fair” is at the top and “Ideal” at the bottom. But what if I would like to order the labels in the reverse order, so that “Ideal” would be at the top?

The order of legend labels can be manipulated by reordering the factor levels of the cut variable mapped to fill aesthetic.

> levels(diamonds$cut)
[1] "Fair"      "Good"      "Very Good" "Premium"
[5] "Ideal"
> diamonds$cut <- factor(diamonds$cut, levels = rev(levels(diamonds$cut)))
> levels(diamonds$cut)
[1] "Ideal"     "Premium"   "Very Good" "Good"
[5] "Fair"

> ggplot(diamonds, aes(clarity, fill = cut)) + geom_bar()

The legend entries are now in reverse order (and so is the stacking).

Changing Data Stacking Order

The order aesthetic changes the order in which the areas are stacked on top of each other.

The following aligns the order of both the labels and the stacking.

> ggplot(diamonds, aes(clarity, fill = cut, order = -as.numeric(cut))) +
+     geom_bar()

Or, alternatively, reordering the factor levels again:

> diamonds$cut <- factor(diamonds$cut, levels = rev(levels(diamonds$cut)))
> ggplot(diamonds, aes(clarity, fill = cut, order = -as.numeric(cut))) +
+     geom_bar()

Let’s assume that I wanted to plot when the sun rises in London in 2010.

sunriset function in maptools package calculates the sunrise times using algorithms provided by the National Oceanic & Atmospheric Administration (NOAA). I need to input the location details in a matrix format and specify for which dates I require the sunrise times.

> library(maptools)

> x_seq <- seq(from = as.POSIXct("2010-01-01", tz = "GMT"),
+     length.out = 365, by = "days")
> coord <- matrix(c(-0.13, 51.5), nrow = 1)

> sunrise <- sunriset(coord, x_seq, direction = "sunrise",
+     POSIXct.out = TRUE)
> head(sunrise, 3)
   day_frac                time
1 0.3376285 2010-01-01 08:06:11
2 0.3375441 2010-01-02 08:06:03
3 0.3374209 2010-01-03 08:05:53

The time variable now includes information about both the date and time of sunrise in class POSIXct.

I would like to plot date on x-axis and time on y-axis, thus the time element needs to be extracted first. However, as the times must be in POSIXct (only times of class POSIXct are supported in ggplot2), a two-step conversion is needed.

First the time is converted to a character vector, effectively stripping all the date information. The time is then converted back to POSIXct with today’s date – the date is of no interest to us, only the hours-minutes-seconds are.

> sunrise$hms <- format(sunrise$time, format = "%H:%M:%S")
> sunrise$hms <- as.POSIXct(sunrise$hms, format = "%H:%M:%S")
> head(sunrise, 3)
   day_frac                time                 hms
1 0.3376285 2010-01-01 08:06:11 2010-01-20 08:06:11
2 0.3375441 2010-01-02 08:06:03 2010-01-20 08:06:03
3 0.3374209 2010-01-03 08:05:53 2010-01-20 08:05:53

Now everything is set for plotting.

> library(ggplot2)

> ggplot(sunrise, aes(time, hms)) + geom_line()

The default x-axis labels could be made somewhat clearer:

> last_plot() + scale_x_datetime("", format = "%b") +
+     ylab("")

This post shows how to achieve a very similar result using ggplot2.

Data Import

FlowingData used last season’s NBA basketball statistics provided by databasebasketball.com, and the csv-file with the data can be downloaded directly from its website.

> nba <- read.csv("http://datasets.flowingdata.com/ppg2008.csv")

The players are ordered by points scored, and the Name variable converted to a factor that ensures proper sorting of the plot.

> nba$Name <- with(nba, reorder(Name, PTS))

Whilst FlowingData uses heatmap function in the stats-package that requires the plotted values to be in matrix format, ggplot2 operates with dataframes. For ease of processing, the dataframe is converted from wide format to a long format.

The game statistics have very different ranges, so to make them comparable all the individual statistics are rescaled.

> library(ggplot2)

> nba.m <- melt(nba)
> nba.m <- ddply(nba.m, .(variable), transform,
+     rescale = rescale(value))

Plotting

There is no specific heatmap plotting function in ggplot2, but combining geom_tile with a smooth gradient fill does the job very well.

> (p <- ggplot(nba.m, aes(variable, Name)) + geom_tile(aes(fill = rescale),
+     colour = "white") + scale_fill_gradient(low = "white",
+     high = "steelblue"))

A few finishing touches to the formatting, and the heatmap plot is ready for presentation.

> base_size <- 9
> p + theme_grey(base_size = base_size) + labs(x = "",
+     y = "") + scale_x_discrete(expand = c(0, 0)) +
+     scale_y_discrete(expand = c(0, 0)) + opts(legend.position = "none",
+     axis.ticks = theme_blank(), axis.text.x = theme_text(size = base_size *
+         0.8, angle = 330, hjust = 0, colour = "grey50"))

Rescaling Update

In preparing the data for the above plot all the variables were rescaled so that they were between 0 and 1.

Jim rightly pointed out in the comments (and I did not initally get it) that the heatmap-function uses a different scaling method and therefore the plots are not identical. Below is an updated version of the heatmap which looks much more similar to the original.

> nba.s <- ddply(nba.m, .(variable), transform,
+     rescale = scale(value))

> last_plot() %+% nba.s

He also asked the following questions: Is there an easier way to do this? How can I make the axes more like the original? What about the white lines between boxes and the gradual change between years? The sort order is also different.

I will present my version in this post, trying to address some of these questions.

Data Import

The list of Crayola crayon colours is available on Wikipedia, and also contains one duplicate colour (#FF1DCE) that was excluded to make further processing easier.

> library(XML)
> library(ggplot2)

> theurl <- "http://en.wikipedia.org/wiki/List_of_Crayola_crayon_colors"
> html <- htmlParse(theurl)
> crayola <- readHTMLTable(html, stringsAsFactors = FALSE)[[2]]
> crayola <- crayola[, c("Hex Code", "Issued", "Retired")]
> names(crayola) <- c("colour", "issued", "retired")
> crayola <- crayola[!duplicated(crayola$colour),
+     ]
> crayola$retired[crayola$retired == ""] <- 2010

Plotting

Instead of geom_rect() I will show two options of plotting the same data using geom_bar() and geom_area() to plot the data, and need to ensure that there’s one entry per colour per year it was(is) in the production.

> colours <- ddply(crayola, .(colour), transform,
+     year = issued:retired)

The plot colours are manually mapped to the original colours using scale_fill_identity().

> p <- ggplot(colours, aes(year, 1, fill = colour)) +
+     geom_bar(width = 1, position = "fill", binwidth = 1) +
+     theme_bw() + scale_fill_identity()

And now the geom_area() version:

> p1 <- ggplot(colours, aes(year, 1, fill = colour)) +
+     geom_area(position = "fill", colour = "white") +
+     theme_bw() + scale_fill_identity()

Final Formatting

Next, the x-axis labels suggested by ggplot2 will be manualy overridden. Also I use a little trick to make sure that the labels are properly aligned.

> labels <- c(1903, 1949, 1958, 1972, 1990, 1998,
+     2010)
> breaks <- labels - 1
> x <- scale_x_continuous("", breaks = breaks, labels = labels,
+     expand = c(0, 0))
> y <- scale_y_continuous("", expand = c(0, 0))
> ops <- opts(axis.text.y = theme_blank(), axis.ticks = theme_blank())

> p + x + y + ops

> p1 + x + y + ops

The order of colours could be changed by sorting the colours by some common feature, unfortunately I did not find an automated way of doing this.

Sorting by Colour

Thanks to Baptiste who showed a way to sort the colours, the final version of the area plot resembles the original even more closely.

> library(colorspace)

> sort.colours <- function(col) {
+     c.rgb = col2rgb(col)
+     c.RGB = RGB(t(c.rgb) %*% diag(rep(1/255, 3)))
+     c.HSV = as(c.RGB, "HSV")@coords
+     order(c.HSV[, 1], c.HSV[, 2], c.HSV[, 3])
+ }
> colours = ddply(colours, .(year), function(d) d[rev(sort.colours(d$colour)),
+     ])

> last_plot() %+% colours

As ggplot2 is all about graphical display, so I went through the list of new features and below is a visual example of each new feature, plotted most often utilising the code examples included in the respective bugtracker issues.

1)geom_text gains parse argument which makes it possible to display expressions

> library(ggplot2)

> set.seed(1)
> mydata <- data.frame(x = sample(10), y = sample(10))
> ggplot(mydata, aes(x, y)) + geom_point() + annotate("text",
+     x = mydata[6, 1], y = mydata[6, 2], label = "beta[1] == 1",
+     parse = T, vjust = 0, hjust = -0.1)

2) all scales now have legend parameter, which defaults to TRUE. Setting to false will prevent that scale from contributing to the legend.

> ggplot(mydata, aes(x, y, colour = x)) + geom_point(legend = FALSE) +
+     geom_line()

In previous version the legend of the above plot looked like this and there was now way to change this.

> ggplot(mydata, aes(x, y, colour = x)) + geom_point() +
+     geom_line()

3) default axis labels and legend titles are now stored in the options, instead of in each scale.

This allows to specify them using the opts call.

> p <- ggplot(mtcars, aes(cyl, mpg, colour = cyl)) +
+     geom_point()
> p + opts(labels = c(x = "Cylinders", y = "Miles per gallon",
+     colour = "Colour"))

The other options to set labels exist as previously:

> p + labs(x = "Cylinders")
> p + xlab("Cylinders")
> p + scale_colour_gradient(name = "Colour")

4) coord_equal: when ratio = NULL (the default), it will adjust the aspect ratio of the plot, rather than trying to extend the shortest axis.

> qplot(mpg, wt, data = mtcars) + coord_equal()

This is what the default looked like in the previous version, and it was impossible to generate the plot above.

> qplot(mpg, wt, data = mtcars) + coord_equal(ratio = 1)

5) x and y positions can be set to Inf or -Inf to refer to the top/right and bottom/left extents of the panel.

This is useful for annotations, and for geom_rect, geom_vline and geom_hline.

> ggplot(data.frame(x = 0:1, y = 0:1)) + geom_rect(aes(x = x,
+     y = y), xmin = 0.1, xmax = 0.2, ymin = -Inf,
+     ymax = Inf)

6)expand_limits(): a new function to make it easy to force the inclusion of any set of values in the limits of any aesthetic.

> p <- qplot(mpg, wt, data = mtcars)

> p + expand_limits(x = 0)

> p + expand_limits(y = c(1, 9))

is the equivalent of

> p + ylim(c(1, 9))

> p + expand_limits(x = 0, y = 0)

It would be good if similar functionality could be extended to xlim, so that the following would work. This way the setting of limits would be encapsulated in one function (xlim/ylim).

> p + xlim(0, Inf)

> library(ggplot2)

> p <- ggplot(dfm, aes(month, value, group = City,
     colour = City)) + geom_line(size = 1) +
     opts(legend.position = "none")

> p + geom_text(data = dfm[dfm$month == "Dec",
     ], aes(label = City), hjust = 0.7, vjust = 1)

The addition of labels requires manual calculation of the label positions which are then passed on to geom_text(). If one wanted to move the labels around, the code would need manual adjustment – label positions need to be recalculated..

This problem is easily solved with the help of directlabels package by Toby Dylan Hocking that “is an attempt to make direct labeling a reality in everyday statistical practice by making available a body of useful functions that make direct labeling of common plots easy to do with high-level plotting systems such as lattice and ggplot2″.

> install.packages("directlabels", repos = "http://r-forge.r-project.org")

> library(directlabels)

The above plot can be reproduced with one line of code.

> direct.label(p, list(last.points, hjust = 0.7,
     vjust = 1))

In addition to several predefined positioning functions, one can also write their own positioning function. For example, placing the rotated labels at the starting values of each series.

> angled.firstpoints <- list("first.points",
     rot = 45, hjust = 0, vjust = -0.7)
> direct.label(p, angled.firstpoints)

I agree with the author’s conclusion that the directlabels package simplifies and makes more convenient the labeling of data series in both lattice and ggplot2.

Thanks to Baptiste for bringing this package to my attention.

Unfortunately the code has not (yet) been released as a package, so when I recently needed to quickly review several datasets at the beginning of an analysis project I started to look for alternatives. A quick search revealed two options that offer similar functionality: r2lUniv package and describe() function in Hmisc package.

r2lUniv

r2lUniv package performs quick analysis either on a single variable or on a dataframe by computing several statistics (frequency, centrality, dispersion, graph) for each variable and outputs the results in a LaTeX format. The output varies depending on the variable type.

> library(r2lUniv)

One can specify the text to be inserted in front of each section.

> textBefore <- paste("\\subsection{", names(mtcars),
+     "}", sep = "")
> rtlu(mtcars, "fileOut.tex", textBefore = textBefore)

The function rtluMainFile generates a LaTeX main document design and allows to further customise the report.

> text <- "\\input{fileOut.tex}"
> rtluMainFile("r2lUniv_report.tex", text = text)

The resulting tex-file can then be converted into pdf.

> library(tools)
> texi2dvi("r2lUniv_report.tex", pdf = TRUE, clean = TRUE)

A sample output for the mpg-variable:

The final pdf-output can be seen here: r2lUniv_report.pdf.

Hmisc

The describe function in Hmisc package determines whether the variable is character, factor, category, binary, discrete numeric, and continuous numeric, and prints a concise statistical summary according to each. The latex report also includes a spike histogram displaying the frequency counts.

> library(Hmisc)

> db <- describe(mtcars, size = "normalsize")

The easiest and fastest way is to print the results to the console.

> db$mpg
mpg
      n missing  unique    Mean     .05     .10     .25     .50
     32       0      25   20.09   12.00   14.34   15.43   19.20
    .75     .90     .95
  22.80   30.09   31.30

lowest : 10.4 13.3 14.3 14.7 15.0
highest: 26.0 27.3 30.4 32.4 33.9

Alternatively, one can convert the describe object into a LaTeX file.

> x <- latex(db, file = "describe.tex")

cat is used to generate the tex-report.

> text2 <- "\\documentclass{article}\n\\usepackage{relsize,setspace}\n\\begin{document}\n\\input{describe.tex} \n\\end{document}"
> cat(text2, file = "Hmisc_describe_report.tex")

> library(tools)
> texi2dvi("Hmisc_describe_report.tex", pdf = TRUE)

A sample output for the mpg-variable:

The final pdf-report can be seen here: Hmisc_describe_report.pdf.

Conclusion

Both of the functions provide similar snapshots of the data, however I prefer the describe function for its more concise output, and also for the option to print the analysis to the console. Whilst I like the summary plots generated by r2lUniv I find them hard to read in the pdf-report because of the small font-size of the labels.

This technique makes a clever use of setting the faceting variable to NULL so that all points are plotted in light grey in all the facets.

> library(ggplot2)

> ggplot(mtcars, aes(cyl, mpg)) + geom_point(data = transform(mtcars,
     gear = NULL), colour = "grey80") + geom_point() +
     facet_grid(~gear) + theme_bw()

Update 17 May 2010

bch asked in the comments below, how to achieve the same when there are two facets. The method is the same, now one would need to exclude both of the facetting variables from the dataset used to draw the light grey points.

> ggplot(mtcars, aes(cyl, mpg)) + geom_point(data = mtcars[,
     !names(mtcars) %in% c("am", "gear")],
     colour = "grey80") + geom_point() + facet_grid(am ~
     gear) + theme_bw()