R/theme_graph.R

In YTLogos/ggraph: An Implementation of Grammar of Graphics for Graphs and Networks

#' A theme tuned for graph visualizations
#'
#' When plotting graphs, networks, and trees the coordinate values are often of
#' no importance and axes are thus a distraction. \code{ggraph} comes with a
#' build-in theme that removes redundant elements in order to put focus on the
#' data. Furthermore the default behaviour is to use a narrow font so text takes
#' up less space. Theme colour is defined by a background and foreground colour
#' where the background defines the colour of the whole graphics area and the
#' foreground defines the colour of the strip and border. By default strip and
#' border is turned off as it is an unnecessary element unless facetting is
#' used. To add a foreground colour to a plot that is already using
#' \code{theme_graph} the \code{th_foreground} helper is provided. In order to
#' use this appearance as default use the \code{set_graph_style} function. An
#' added benefit of this is that it also changes the default text-related values
#' in the different geoms for a completely coherent look.
#' \code{unset_graph_style} can be used to revert the defaults back to their
#' default settings (that is, they are not necessarily reverted back to what
#' they were prior to calling \code{set_graph_style}).
#'
#' @param background The colour to use for the background. This theme sets all
#' background elements except for plot.background to \code{element_blank} so
#' this controls the background for all elements of the plot. Set to \code{NA}
#' to remove the background (thus making the plot transparent)
#'
#' @param foreground The colour of foreground elements, specifically strip and
#' border. Set to \code{NA} to remove.
#'
#' @param border Logical. Should border be drawn if a foreground colour is
#' provided?
#'
#' @param family,base_family,title_family,subtitle_family,strip_text_family,caption_family The font to use for the different elements
#'
#' @param base_size,size,text_size,title_size,subtitle_size,strip_text_size,caption_size The size to use for the various text elements. \code{text_size} will be used as geom defaults
#'
#' @param face,title_face,subtitle_face,strip_text_face,caption_face The fontface to use for the various text elements
#'
#' @param title_margin,subtitle_margin,caption_margin The margin to use between the text elements and the plot area
#'
#' @param text_colour,bg_text_colour,fg_text_colour,title_colour,subtitle_colour,strip_text_colour,caption_colour The colour of the text in the various text elements
#'
#' @param plot_margin The plot margin
#'
#' @export
#'
#' @examples
#' library(igraph)
#' graph <- graph_from_data_frame(highschool)
#'
#' ggraph(graph) + geom_edge_link() + geom_node_point() + theme_graph()
#'
theme_graph <- function(base_family = 'Arial Narrow', base_size = 11,
                        background = 'white', foreground = NULL, border = TRUE,
                        text_colour = 'black', bg_text_colour = text_colour,
                        fg_text_colour = text_colour,
                        title_family = base_family, title_size = 18,
                        title_face = "bold", title_margin = 10,
                        title_colour = bg_text_colour,
                        subtitle_family = base_family, subtitle_size = 12,
                        subtitle_face = "plain", subtitle_margin = 15,
                        subtitle_colour = bg_text_colour,
                        strip_text_family = base_family, strip_text_size = 10,
                        strip_text_face = "bold", strip_text_colour = fg_text_colour,
                        caption_family = base_family, caption_size = 9,
                        caption_face = "italic", caption_margin = 10,
                        caption_colour = bg_text_colour,
                        plot_margin = margin(30, 30, 30, 30)) {
    style <- theme_bw(base_size = base_size, base_family = base_family)
    style <- style + theme(
        text = element_text(colour = text_colour),
        plot.title = element_text(family = title_family,
                                  size = title_size,
                                  face = title_face,
                                  colour = title_colour,
                                  margin = margin(b = title_margin)),
        plot.subtitle = element_text(family = subtitle_family,
                                     size = subtitle_size,
                                     face = subtitle_face,
                                     colour = subtitle_colour,
                                     margin = margin(b = subtitle_margin)),
        plot.caption = element_text(family = caption_family,
                                    size = caption_size,
                                    face = caption_face,
                                    colour = caption_colour,
                                    margin = margin(t = caption_margin)),
        strip.text = element_text(family = strip_text_family,
                                  size = strip_text_size,
                                  face = strip_text_face,
                                  colour = strip_text_colour),

        plot.margin = plot_margin,

        legend.background = element_blank(),
        legend.box.background = element_blank(),
        legend.key = element_blank(),
        panel.background = element_blank(),
        axis.title = element_blank(),
        axis.text = element_blank(),
        axis.line = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),

        strip.background = if (is.null(foreground)) element_blank() else element_rect(fill = foreground, colour = foreground),
        plot.background = if (is.null(background)) element_blank() else element_rect(fill = background, colour = NA),
        panel.border = if (border && !is.null(foreground)) element_rect(fill = NA, colour = foreground) else element_blank()
    )

    style
}
#' @rdname theme_graph
#'
#' @export
th_foreground <- function(foreground = 'grey80', fg_text_colour = NULL, border = FALSE) {
    th <- theme(
        strip.background = if (is.null(foreground)) element_blank() else element_rect(fill = foreground, colour = foreground),
        panel.border = if (border && !is.null(foreground)) element_rect(fill = NA, colour = foreground) else element_blank()
    )
    if (!is.null(fg_text_colour)) {
        th <- th + theme(strip.text = element_text(colour = fg_text_colour))
    }
    th
}
#' @rdname theme_graph
#'
#' @param ... Parameters passed on the \code{theme_graph}
#'
#' @export
set_graph_style <- function(family = 'Arial Narrow', face = 'plain', size = 11,
                            text_size = 11, text_colour = 'black', ...) {
    style <- theme_graph(base_family = family, base_size = size,
                         text_colour = text_colour, ...)
    theme_set(style)
    text_size <- text_size / .pt

    update_geom_defaults(GeomEdgePath, list(
        family = family,
        fontface = face,
        label_size = text_size
    ))
    update_geom_defaults(GeomText, list(
        family = family,
        fontface = face,
        size = text_size
    ))
    update_geom_defaults(GeomTextRepel, list(
        family = family,
        fontface = face,
        size = text_size
    ))
    update_geom_defaults(GeomLabel, list(
        family = family,
        fontface = face,
        size = text_size
    ))
    update_geom_defaults(GeomLabelRepel, list(
        family = family,
        fontface = face,
        size = text_size
    ))
}
#' @rdname theme_graph
#'
#' @export
unset_graph_style <- function() {
    style <- theme_gray()
    theme_set(style)

    update_geom_defaults(GeomEdgePath, list(
        family = '',
        fontface = 1,
        label_size = 3.88
    ))
    update_geom_defaults(GeomText, list(
        family = '',
        fontface = 1,
        size = 3.88
    ))
    update_geom_defaults(GeomTextRepel, list(
        family = '',
        fontface = 1,
        size = 3.88
    ))
    update_geom_defaults(GeomLabel, list(
        family = '',
        fontface = 1,
        size = 3.88
    ))
    update_geom_defaults(GeomLabelRepel, list(
        family = '',
        fontface = 1,
        size = 3.88
    ))
    update_geom_defaults(GeomAxisHive, list(
        family = '',
        fontface = 1,
        size = 3.88
    ))
}