Annotations for ggplot2 graphics

[Sharpie]

Once Annotations for grid graphics is completed TikZ annotations will be available as Grid grob objects and would be nice to provide GGplot graphics with easy access to TikZ annotation using a custom geom object.

Something like the way geom_text works:

p <- qplot(wt, mpg, data = mtcars) + geom_tikz(1,1, 'node', "wow!")
print(p)

The actual semantics of geom_tikz can be worked out later. The first step will be to ensure GGplot coordinate transformations are taken into account when placing annotations.

[osthomas]

Hi,

first of all, thank you for the maintenance of this amazing tool. It is an integral part of my workflow and essential to satisfy my pedantism.

I was really interested in being able to annotate ggplots so I hacked together something which allows to add arbitrary TikZ annotations using

• the plot coordinate system, even with facets by specifying the facet of interest,
• relative positions with respect to individual panels, e.g. (0.5, 0.5) is the center of the panel,
• relative positions with respect to the whole plot.

My implementation is far from elegant, but (according to my admittedly very limited tests) it works and it was useful to me, so perhaps it can be to someone else or help in adding this feature in a more elaborate way.

In particular, I know too little to do the coordinate transformations from ggplot to TikZ myself, so I exploited tikzDevice to do the dirty work by providing the required coordinates in npc units and letting it place coordinates, from which a scope with suitable coordinate transforms is generated. This requires \usetikzlibrary{calc} in the preamble! Furthermore, in order to extract the axis ranges, the plot object has to be passed.

The code for a complete compilable knitr document is below, the relevant code is in the setup chunk. The compilation result on my system is attached: tikzdevice_ggplot.pdf

I think it would be useful if there was a way to disable the automatic clipping for these annotations. This would make post-R annotation outside of the plot area a lot easier.

\documentclass[a4paper]{article}
\usepackage[utf8]{inputenc}
\usepackage[T1]{fontenc}
\usepackage{tikz}
\usetikzlibrary{calc}
\tikzset{
    dot/.style={outer sep=0, inner sep=0, circle, fill=red, minimum size=2pt},
    every pin/.append style={scale=0.5, pin distance=2pt, text width=3cm}
}
\begin{document}
<<setup, include=FALSE>>=
library(tikzDevice)
library(ggplot2)
library(stringr)
library(grid)

locate_panel <- function(panelx, panely) {
    # Panels are identified by
    # * panel.<cellY>-<cellX>-<cellY>-<cellX>, if there is only one panel or
    # * panel-x-y.<cellY>-<cellX>-<cellY>-<cellX> if there are multiple panels,
    # with cellX and cellY specifying the appearance panel position within the panel matrix.
    # the x-y part after 'panel' does not appear to correlate.
    # Extract location position
    panels <- str_extract_all(as.character(current.vpTree()), "panel(-\\d-\\d)*\\.[\\d-]*", simplify = TRUE)
    # panels_pos <- str_match(panels, "panel(-(\\d)-(\\d))*.*")[,c(1,3,4), drop = FALSE]
    panels_pos <- str_match(panels, "panel-*\\d*-*\\d*\\.(\\d+)-(\\d+).*")
    panels_pos[is.na(panels_pos)] <- 1
    colnames(panels_pos) <- c("panel", "y", "x")
    # The cellX and cellY identifiers are not sequentiel because there are margins in between panels.
    xs <- sort(as.numeric(unique(panels_pos[,"x"])))
    ys <- sort(as.numeric(unique(panels_pos[,"y"])))
    # Order by x and y position to infer sequence location from matrix location
    # The order is important. This way, it matches up with the order in ggplot_build(p)$layout$panel_params
    panels_pos <- panels_pos[order(as.numeric(panels_pos[,"y"]), as.numeric(panels_pos[,"x"])),, drop = FALSE]
    print(panels_pos)
    panel_name <- panels_pos[panels_pos[,"x"] == xs[panelx] & panels_pos[,"y"] == ys[panely]][1]
    print(panel_name)
    panel_number <- which(panels_pos[,"panel"] == panel_name)
    # Activate the correct panel
    seekViewport(panel_name)
    return(panel_number)
}

gg_axis_range <- function(p, axis, panelx = 1, panely = 1) {
    if (axis == "x") {
        return(ggplot_build(p)$layout$panel_params[[locate_panel(panelx, panely)]]$x.range)
    } else if (axis == "y") {
        return(ggplot_build(p)$layout$panel_params[[locate_panel(panelx, panely)]]$y.range)
    } else {
        stop("`axis` must be either 'x' or 'y'.")
    }
}

gg_to_npc <- function(p, x, y, panelx = 1, panely = 1) {
    panel_number <- locate_panel(panelx, panely)
    xrange <- gg_axis_range(p, "x", panelx = panelx, panel = panely)
    yrange <- gg_axis_range(p, "y", panelx = panelx, panel = panely)
    # Formula from here: https://stackoverflow.com/questions/9450873/locator-equivalent-in-ggplot2-for-maps
    x_trans <- (x - xrange[1]) / diff(range(xrange))
    y_trans <- (y - yrange[1]) / diff(range(yrange))

    coords <- c(x_trans, y_trans)
    # coords <- gridToDevice(x_trans, y_trans, unit="npc")
    return(coords)
}

ggplot_tikzAxisScope <- function(p, annotation, panelx = 1, panely = 1, relative = FALSE, relativeTo = "panel") {
    mult <- 1
    if (relative & relativeTo == "panel") {
        xrange <- gg_axis_range(p, "x", panelx = panelx, panel = panely)
        yrange <- gg_axis_range(p, "y", panelx = panelx, panel = panely)
        p00 <- gg_to_npc(p, xrange[1], yrange[1], panelx = panelx, panely = panely)
        p11 <- gg_to_npc(p, xrange[2], yrange[2], panelx = panelx, panely = panely)
    } else if (relative & relativeTo == "plot") {
        p00 <- c(0, 0)
        p11 <- c(1, 1)
    } else if (relative) {
        stop("`relativeTo` must be either 'panel' or 'plot'.")
    } else {
        # Multiply unit vector to compensate rounding error with small steps because tikzDevice
        # limits its output to 2 decimal places.
        mult <- 50
        p00 <- gg_to_npc(p, 0, 0, panelx = panelx, panely = panely)
        p11 <- gg_to_npc(p, 1*mult, 1*mult, panelx = panelx, panely = panely)
    }
    grid.tikzCoord(x = p00[1], y = p00[2], name = "p00", units="npc")
    grid.tikzCoord(x = p11[1], y = p11[2], name = "p11", units="npc")
    grid.tikzAnnotate("\\coordinate (coord_length) at ($(p11)-(p00)$);")
    grid.tikzAnnotate(paste0("\\path let \\p1 = (coord_length) in coordinate (X) at (\\x1/",mult,",0);"))
    grid.tikzAnnotate(paste0("\\path let \\p1 = (coord_length) in coordinate (Y) at (0,\\y1/",mult,");"))
    grid.tikzAnnotate(paste0("
    \\begin{scope}[x=(X), y=(Y), shift=(p00)]
    ", annotation, "
    \\end{scope}
    "))
}
@
\section{Single Panel, panel coordinates}
<<single_panel, include=FALSE>>=
p <- ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_point()
tikz("single_panel.tikz", width = 5, height = 3)
p
ggplot_tikzAxisScope(p, "\\node[dot, pin={30:(2, 2)}] at (2,2) {};")
dev.off()
@
\input{single_panel.tikz}

\section{Single Panel, Relative to panel}
<<single_panel_relative, include=FALSE>>=
p <- ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_point()
tikz("single_panel_relative.tikz", width = 5, height = 3)
p
ggplot_tikzAxisScope(p, "
    \\node[dot, pin={120:(0.5, 0.5) relative}] at (0.5,0.5) {};
    \\node[dot, pin={60:(0, 0) relative}] at (0,0) {};
    \\node[dot, pin={210:(1, 1) relative}] at (1,1) {};
    ", relative = TRUE)
dev.off()
@
\input{single_panel_relative.tikz}

\section{Single Panel, Relative to plot}
<<single_panel_relative_plot, include=FALSE>>=
p <- ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_point()
tikz("single_panel_relative_plot.tikz", width = 5, height = 3)
p
ggplot_tikzAxisScope(p, "
    \\node[dot, pin={120:(0.5, 0.5) relative}] at (0.5,0.5) {};
    \\node[dot, pin={30:(0, 0) relative}] at (0,0) {};
    \\node[dot, pin={210:(1, 1) relative}] at (1,1) {};
    ",
    relative = TRUE, relativeTo = "plot")
dev.off()
@
\input{single_panel_relative_plot.tikz}

\section{Multiple Panels, panel coordinates, grid}
<<mutli_panel_plot, include=FALSE>>=
p <- ggplot(data=diamonds[1:1000,], aes(carat, price, color=color)) + geom_point() + facet_grid(color~clarity, scales="free") + theme_gray(base_size=5)
tikz("multi_panel.tikz", width = 5, height = 3)
p
ggplot_tikzAxisScope(p, "
    \\node[dot, pin={0:panel(2,1),\\\\(0.25, 1000)}] at (0.25,1000) {};
    ", panelx = 2, panely = 1)
ggplot_tikzAxisScope(p, "
    \\node[dot, pin={300:{panel(4, 7),\\\\(0.4, 2000)}}] at (0.4,2000) {};
    ", panelx = 4, panely = 7)
dev.off()
@
\input{multi_panel.tikz}

\section{Multiple Panels, panel coordinates, wrap}
<<mutli_panel_plot_facet, include=FALSE>>=
p <- ggplot(data=diamonds[1:1000,], aes(carat, price, color=color)) + geom_point() + facet_wrap(~color, ncol=3) + theme_gray(base_size=5)
tikz("multi_panel_facet.tikz", width = 5, height = 3)
p
ggplot_tikzAxisScope(p, "
    \\node[dot, pin={0:panel(2,1),\\\\(0.25, 1000)}] at (0.25,1000) {};
    ", panelx = 2, panely = 1)
ggplot_tikzAxisScope(p, "
    \\node[dot, pin={300:{panel(3,2),\\\\(0.25, 2000)}}] at (0.25,2000) {};
    ", panelx = 3, panely = 2)
dev.off()
@
\input{multi_panel_facet.tikz}

\section{Multiple Panels, Relative to panel}
<<mutli_panel_plot_relative, include=FALSE>>=
p <- ggplot(data=diamonds[1:1000,], aes(carat, price, color=color)) + geom_point() + facet_wrap(~color, ncol=3) + theme_gray(base_size=5)
tikz("multi_panel_facet_relative.tikz", width = 5, height = 3)
p
ggplot_tikzAxisScope(p, "
    \\node[dot, pin={0:panel(2,1),\\\\(0.5, 0.5) relative}] at (0.5, 0.5) {};
    ", panelx = 2, panely = 1, relative=TRUE)
dev.off()
@
\input{multi_panel_facet_relative.tikz}

\section{Multiple Panels, Relative to plot}
<<mutli_panel_plot_relative_plot, include=FALSE>>=
p <- ggplot(data=diamonds[1:1000,], aes(carat, price, color=color)) + geom_point() + facet_wrap(~color, ncol=3) + theme_gray(base_size=5)
tikz("multi_panel_facet_relative_plot.tikz", width = 5, height = 3)
p
ggplot_tikzAxisScope(p, "
    \\node[dot, pin={0:(0.5, 0.5) relative}] at (0.5, 0.5) {};
    ", panelx = 2, panely = 1, relative=TRUE, relativeTo="plot")
dev.off()
@
\input{multi_panel_facet_relative_plot.tikz}

\end{document}

[Sharpie]

Hi @O-T, I'm glad you're finding the package useful! My current line of work has taken me away from crunching numbers and running reports in R, so development is no longer happening in my repository.

Looks like you have found daqana/tikzDevice, which is where CRAN is currently pointing for development. Good luck!