R/chronochrt_plot.R

In chronochrt: Creating Chronological Charts

#' Plot a chronological chart
#'
#' This function converts a chronological data set into a chronological chart.
#' It provides basic features for the export of the plot and for its
#' customisation.
#'
#' This function is wrapper around various functions for an quick and convenient
#' way to draw chronological charts. It relies on the common data structure of
#' ChronochRt (see \code{vignette("ChronochRt")} for details). For full
#' customisation use the respective geoms to build your own plot.
#'
#' It is assumed that the majority of the text labels will be placed on the
#' right side of each column. Therefore they are right aligned to prevent them
#' from running outside the plotting area. Vertically, it will be placed centred
#' on the \code{year} given. Text in labels can be wrapped by inserting
#' \code{"\n"} (without blanks).
#'
#' @inheritParams geom_chronochRt
#' @param data A data set with chronological data.
#' @param labels_text A data set containing the text labels.
#' @param labels_image A data set containing the image labels.
#' @param axis_title A character string with the axis label of the vertical
#'   axis. Default is \code{"Years"}.
#' @param size_text Font size of the names of the chronological units in mm. All
#'   other text elements will be scaled accordingly. The default is \code{6} mm.
#' @param height_image The absolute height of the image labels in cm. The
#'   default is  \code{2} cm.
#' @param size_line Thickness of the line in mm. The default is \code{0.5} mm.
#' @param fill_chron Fill colour of the chronological units. The default is
#'   \code{"white"}. See the colour specification section of
#'   \code{\link[graphics]{par}} for how to specify colours in R.
#' @param color_chron Line (border) colour of the chronological units. The
#'   default is \code{"black"}. See the colour specification section of
#'   \code{\link[graphics]{par}} for how to specify colours in R.
#' @param color_label Colour of the text labels. The default is \code{"black"}.
#'   See the colour specification section of \code{\link[graphics]{par}} for how
#'   to specify colours in R.
#' @param line_break Line length of the section labels in characters. Text will
#'   be wrapped at the blank closest to the specified number of characters.
#'   Default is \code{10} characters.
#' @param filename A character string with the filename or path. If specified,
#'   the plot will be saved in the given location. The file format is
#'   automatically recognised from the file extension. The most common file
#'   types are supported, e.g. \code{.tiff}, \code{.png}, \code{.jpg},
#'   \code{.eps}, and \code{.pdf}. To export as \code{.svg} installation of the
#'   package \pkg{svglite} is required. See \code{\link[ggplot2]{ggsave}} for
#'   more details about the supported file formats.
#' @param plot_dim Dimensions of the plot as a vector in the format
#'   \code{c(width, height, units)}. Supported units are "cm", "mm", in". For
#'   example, \code{plot_dim = c(5,5,"cm")} will produce a plot of the
#'   dimensions 5 x 5 cm. If unspecified, the standard values of the respective
#'   graphic device are used.
#' @param background Optional specifications for the background of the
#'   chronological chart as vector in the format \code{c(background colour,
#'   linetype of grid lines)} to overwrite the default behaviour of
#'   \code{\link{theme_chronochrt}}. Any valid colour and line type
#'   specifications are accepted, e.g. \code{c("grey90", "dotted")} (these are
#'   the default values of \code{\link{theme_chronochrt}}. See the sections
#'   "colour specification" and "line type specification" in
#'   \code{\link[graphics]{par}} for how to specify colours and line types in R.
#' @param ... Additional arguments passed to \code{\link[ggplot2]{ggsave}} to
#'   enhance the saved plot like \code{dpi} to specify its resolution. See
#'   \code{\link[ggplot2]{ggsave}} for detailed information.
#'
#' @return
#'
#' A ggplot2 object with the chronological chart.
#'
#' @export
#'
#' @examples
#'
#' # Create Example data
#' chrons <- data.frame(region = c("A", "B", "B", "B", "A"),
#'                      name = c("a", "a", "1", "2", "b"),
#'                      start = c(-100, -100, -100, "0/50", "50_100"),
#'                      end = c("50_100", 150, "0/50", 150, 200),
#'                      level = c(1, 1, 2, 2, 1),
#'                      add = FALSE)
#'
#' # Plot with default options
#' plot_chronochrt(chrons)
#'
#' # Add labels
#' labels <- data.frame(region = "A",
#'                      year = -50,
#'                      position = 0.5,
#'                      label = "Event")
#'
#' images <- data.frame(region = "B",
#'                      year = 100,
#'                      position = 0.5,
#'                      image_path = "https://www.r-project.org/logo/Rlogo.png")
#'
#' plot_chronochrt(chrons, labels, images)
#'
#' # Customise plot
#' plot_chronochrt(chrons, axis_title = "BC/AD", year_lim = c(-50,100),
#'                 fill_chron = "black", color_chron = "white", size_line = 5)
#' plot_chronochrt(chrons, labels, images, color_label = "red", size_text = 5, height_image = 4)
#'
#' # Export plot
#'
#' file <- tempfile(fileext = ".jpg")
#'
#' plot_chronochrt(chrons, filename = tempfile(fileext = ".jpg"),
#'   plot_dim = c(10, 15, "cm"))
#'
#'   # with additional parameters
#'   plot_chronochrt(chrons, filename = tempfile(fileext = ".jpg"),
#'     plot_dim = c(10, 15, "cm"), dpi = 300)
#'
#' unlink(file)
#'
#' # Additional customisation with ggplot2
#' plot_chronochrt(chrons) + ggplot2::theme_bw()


plot_chronochrt <- function(data, labels_text = NULL, labels_image = NULL, year_lim = NULL, axis_title = "Years", minimal = FALSE, size_text = 6, height_image = 2, size_line = 0.5, fill_chron = "white", color_chron = "black", color_label = "black", line_break = 10, filename = NULL, plot_dim, background = NULL, ...)
{

  if (is.data.frame(data)) {

    if (!("region" %in% names(data))) {stop("Wrong input format: The column `region` in ", substitute(data), " does not exist.")}
    if (!("name" %in% names(data))) {stop("Wrong input format: The column `name` in ", substitute(data), " does not exist.")}
    if (!("start" %in% names(data))) {stop("Wrong input format: The column `start` in ", substitute(data), " does not exist.")}
    if (!("end" %in% names(data))) {stop("Wrong input format: The column `end` in ", substitute(data), " does not exist.")}
    if (!("level" %in% names(data))) {stop("Wrong input format: The column `level` in ", substitute(data), " does not exist.")}
    if (!("add" %in% names(data))) {stop("Wrong input format: The column `add` in ", substitute(data), " does not exist.")}

    if (!all(is.character(data$region) | is.factor(data$region), is.character(data$name), is.numeric(data$start) | is.character(data$start), is.numeric(data$end) | is.character(data$end), is.numeric(data$level), is.logical(data$add))) {
      stop("One or more columns of the data set contain incompatible data. Data must be strings (region, name), numbers (start, end), whole numbers (level), and logical (add).")
    }
    if (!all(round(data$level) == data$level)) {
      stop("Wrong input format: level must contain only whole numbers (1, 2, 3, ...)")
    }
  } else {
    stop("Wrong input format: ", substitute(data) , " must be a data frame or tibble.")
  }

  if (!is.null(labels_text)) {
    if (is.data.frame(labels_text)) {
      if (!("region" %in% names(labels_text))) {stop("Wrong input format: The column `region` in ", substitute(labels_text), " does not exist.")}
      if (!("year" %in% names(labels_text))) {stop("Wrong input format: The column `year` in ", substitute(labels_text), " does not exist.")}
      if (!("label" %in% names(labels_text))) {stop("Wrong input format: The column `label` in ", substitute(labels_text), " does not exist.")}
      if (!("position" %in% names(labels_text))) {stop("Wrong input format: The column `position` in ", substitute(labels_text), " does not exist.")}

      if (!all(is.character(labels_text$region) | is.factor(labels_text$region), is.numeric(labels_text$year), is.character(labels_text$label), is.numeric(labels_text$position))) {
        stop("One or more columns of the text label data contain incompatible data. Data must be strings (region, label) and numeric (year, position).")
      }
    } else {
      stop("Wrong input format: ", substitute(labels_text) , " must be a data frame or tibble.")
    }
  }

  if (!is.null(labels_image)) {
    if (is.data.frame(labels_image)) {
      if (!("image_path" %in% names(labels_image))) {stop("Wrong input format: The column `region` in ", substitute(labels_image), " does not exist.")}
      if (!("region" %in% names(labels_image))) {stop("Wrong input format: The column `region` in ", substitute(labels_image), " does not exist.")}
      if (!("year" %in% names(labels_image))) {stop("Wrong input format: The column `year` in ", substitute(labels_image), " does not exist.")}
      if (!("position" %in% names(labels_image))) {stop("Wrong input format: The column `position` in ", substitute(labels_image), " does not exist.")}

      if (!all(is.character(labels_image$region) | is.factor(labels_image$region), is.numeric(labels_image$year), is.character(labels_image$image_path), is.numeric(labels_image$position))) {
        stop("One or more columns of the image label data contain incompatible data. Data must be strings (region, label, image_path) and numeric (year, position).")
      }
    } else {
      stop("Wrong input format: ", substitute(labels_image) , " must be a data frame or tibble.")
    }
  }

  if (!is.null(year_lim) && any(!is.numeric(year_lim), length(year_lim) != 2)) {stop("Wrong input format: ", year_lim, " must be a numberic vector of length 2.")}
  if (!is.character(axis_title)) {stop("Wrong input format: ", axis_title, " must be a character string.")}
  if (!is.numeric(size_text) || length(size_text) != 1) {stop("Wrong input format: ", size_text, " must be a number.")}
  if (!any(is.character(fill_chron), is.numeric(fill_chron)) || length(fill_chron) != 1) {fill_chron <- "white"}
  if (!any(is.character(color_chron), is.numeric(color_chron)) || length(color_chron) != 1) {color_chron <- "black"}
  if (!any(is.character(color_label), is.numeric(color_label)) || length(color_label) != 1) {color_label <- "black"}
  if (!is.numeric(height_image) || length(height_image) != 1) {stop("Wrong input format: ", height_image, " must be a number.")}
  if (!is.logical(minimal)) {stop("Wrong input format: ", minimal, " must be 'TRUE' or 'FALSE'.")}
  if (!is.numeric(size_line) || length(size_line) != 1) {stop("Wrong input format: ", size_line, " must be a number.")}
  if (!is.numeric(line_break) || length(line_break) != 1) {stop("Wrong input format: ", line_break, " must be a number.")}
  if (!is.null(filename)) {
    if (!is.character(filename)) {stop("Wrong input format: ", filename, " must be a character string.")}
    if (!dir.exists(dirname(filename))) {stop("The directory ", dirname(filename), " does not exist.")}
    if (!is.null(plot_dim)) {

      if (!plot_dim[3] %in% c("in", "cm", "mm")) {stop("This unit is not supported. Only the following units are support: mm, cm, in.")}

      width <- as.numeric(plot_dim[1])
      height <- as.numeric(plot_dim[2])
      units <- as.character(plot_dim[3])

    } else {

      width <- NA
      height <- NA
      units <- NULL
    }
  }
  if(!is.null(background)) {
    if (length(background) != 2) {stop("Wrong input format:", background, " is not a vector of length 2.")}
    bg_fill <- background[1]
    grid_linetype <- background[2]
  }

  plot <- ggplot2::ggplot() +
    geom_chronochRt(data = data, ggplot2::aes(region = .data$region, name = .data$name, start = .data$start, end = .data$end, level = .data$level, add = .data$add), minimal = minimal, year_lim = year_lim, size_text = size_text, fill = fill_chron, color = color_chron, size_line = size_line)

  if (!is.null(labels_text)) {
    plot <- plot + ggplot2::geom_text(data = labels_text, ggplot2::aes(y = .data$year, x = .data$position, label = .data$label, hjust = 1, vjust = 0.5), na.rm = TRUE, size = size_text*0.75, color = color_label)
  }

  if (!is.null(labels_image)) {
    plot <- plot + geom_chronochRtImage(data = labels_image, ggplot2::aes(image_path = .data$image_path, x = .data$position, y = .data$year, height = height_image))
  }

  plot <- plot +
    ggplot2::scale_x_continuous(expand = c(0,0)) +
    ggplot2::scale_y_continuous(name = axis_title, expand = c(0,0)) +
    ggplot2::facet_grid(cols = ggplot2::vars(.data$region), scales = "free_x", space = "free_x", labeller = ggplot2::label_wrap_gen(width = line_break)) +
    theme_chronochrt() +
    ggplot2::theme(axis.text = ggplot2::element_text(size = size_text*0.8*72.27/25.4),
                   axis.title = ggplot2::element_text(size = size_text*72.27/25.4, face="bold"),
                   strip.text.x = ggplot2::element_text(size = size_text*1.25*72.27/25.4, face="bold"))

  if(!is.null(background)) {
    plot <- plot +
      ggplot2::theme(panel.background = ggplot2::element_rect(fill = bg_fill),
                     panel.grid = ggplot2::element_line(linetype = grid_linetype))
  }

  if(!is.null(filename)) {
    ggplot2::ggsave(plot = plot, filename = filename, width = width, height = height, units = units, ...)
  }

  plot
}