R/ggplot-theme.R

#' IDS Theme for ggplot2
#'
#' Based on Highcharts ggtheme \link[ggthemes]{theme_hc}
#' which again is based on the plots in \url{Highcharts JS}.
#'
#' @note
#'
#' Note that here, unlike with the highcharter theme, you have to set the scale
#' explicitly.
#'
#'
#' @references
#'
#' \link[ggthemes]{theme_hc}
#'
#' \url{http://www.highcharts.com/demo/line-basic}
#'
#' \url{https://github.com/highslide-software/highcharts.com/tree/master/js/themes}
#'
#' @inheritParams ggplot2::theme_bw
#' @param style \code{'light'}, \code{'dark'}.
#' @param bgcolor Deprecated
#' @example inst/examples/ex-ggplot.R
#' @family themes ids
#' @importFrom ggplot2 theme element_rect element_text element_line element_blank
#' @export
theme_ids <- function(base_size = 14,
                     base_family = idsBaseFontFamily,
                     style = c("default", "light", "dark"),
                     bgcolor = NULL) {

  if (!is.null(bgcolor)) {
    warning("`bgcolor` is deprecated. Use `style` instead.")
    style <- bgcolor
  }
  style <- match.arg(style)
  bgcolor <- switch(style,
                    default = backgroundColor,
                    "light" = backgroundColor,
                    "mono" = backgroundColor,
                    "dark" = backgroundColorDark)

  ret <- theme(rect = element_rect(fill = bgcolor, linetype = 0, colour = NA),
               text = element_text(size = base_size, family = base_family),
               plot.title = element_text(hjust = 0.5),
               plot.subtitle = element_text(hjust = 0.5, size = 13, colour = mediumContrastColor),
               title = element_text(hjust = 0.5),
               axis.title.x = element_text(hjust = 0.5, size=11),
               axis.title.y = element_text(hjust = 0.5, size=11),
               legend.title = element_text(size=11),
               panel.grid.major.y = element_line(colour = lowContrastColor),
               panel.grid.minor.y = element_blank(),
               panel.grid.major.x = element_blank(),
               panel.grid.minor.x = element_blank(),
               panel.border = element_blank(),
               panel.background = element_blank(),
               legend.position = "right",
               legend.key = element_rect(fill = paste0(bgcolor,"00")))

  if (style == "dark") {
    ret <- (ret + theme(rect = element_rect(fill = bgcolor),
                        text = element_text(colour = textColorDark),
                        plot.title = element_text(colour = highContrastColorDark),
                        plot.subtitle = element_text(colour = mediumContrastColorDark),
                        axis.title.x = element_text(colour = textColorDark),
                        axis.title.y = element_text(colour = textColorDark),
                        axis.text.x = element_text(color=textColorDark),
                        axis.text.y = element_text(color=textColorDark),
                        panel.grid.major.y = element_line(colour = lowContrastColorDark),
                        legend.title = element_text(colour = textColorDark)))
  }
  ret
}


#' IDS color and fill scales
#'
#' Colour and fill scales which use the palettes in
#' \code{\link{ids_pal}()} and are meant for use with
#' \code{\link{theme_ids}()}.
#'
#' @param palette A palette function that when called with a single integer
#' argument (the number of levels in the scale) returns the values that they should take.
#'
#' @importFrom ggthemes gdocs_pal
#' @importFrom ggplot2 discrete_scale
#'
#' @inheritDotParams  ggthemes::scale_colour_gdocs
#' @family colour ids
#' @rdname scale_ids
#' @export
scale_colour_ids <- function(palette = "default", ...) {
  discrete_scale("colour", "ids", ids_pal(palette=palette, ...))
}

#' @rdname scale_ids
#' @inheritDotParams  ggthemes::scale_colour_gdocs
#' @importFrom ggplot2 discrete_scale
#' @export
scale_color_ids <- scale_colour_ids

#' @rdname scale_ids
#' @inheritParams ggthemes::scale_fill_gdocs
#' @importFrom ggplot2 discrete_scale
#' @export
scale_fill_ids <- function(palette = "default", ...) {
  discrete_scale("fill", "ids", ids_pal(palette=palette, ...))
}