R/jp_theme.R

In dzulfiqarfr/jpwrapper: Customize Datawrapper Charts With Design Pricniples Used at The Jakarta Post

#' Modify nondata components
#'
#' Customize nondata components in Datawrapper line, bar and column charts,
#' as well as scatter plots.
#'
#' @param chart_id A string of the Datawrapper chart ID.
#' @param subtitle_color Subtitle color. Defaults to `#757575`.
#' @param y_grid_labels Grid label position. Defaults to `inside`.
#' @param x_grid Grid lines on the x-axis. Defaults to `ticks`.
#'   For scatter plots, `no-labels` will show grid lines without axis labels
#'   and `just-labels` will display the axis labels without grid lines.
#' @param y_grid Grid lines on the y-axis. Defaults to `on`.
#'   For scatter plots, `no-labels` will show grid lines without axis labels
#'   and `just-labels` will display the axis labels without grid lines.
#' @param labeling Color legend. Defaults to `off`. If `top`, adds a color
#'   legend to the top of the chart. If `right`, label the data directly
#'   on the right side of the chart.
#' @param jp_logo The Jakarta Post logo. Defaults to `FALSE`. If `TRUE`, adds the
#'   Post's logo to the right-bottom of chart.
#' @param download_data Defaults to `FALSE`. If `TRUE`, adds a button to
#'   download the data to the bottom of the chart.
#' @param download_image Defaults to `FALSE`. If `TRUE`, adds a button to
#'   download the chart as an image to the bottom of the chart.
#'
#' @seealso The underlying function: \code{\link[DatawRappr]{dw_edit_chart}}
#'
#' @examples
#' \dontrun{
#' jp_theme(
#'   chart_id = "abcD3",
#'   subtitle_color = "#90A4AE",
#'   x_grid = "off",
#'   y_grid = "ticks",
#'   labeling = "top",
#'   jp_logo = TRUE,
#'   download_data = TRUE,
#'   download_image = TRUE
#' )
#' }
#'
#' @export
jp_theme <- function(chart_id,
                     subtitle_color = "#757575",
                     y_grid_labels = "inside",
                     x_grid = "ticks",
                     y_grid = "on",
                     labeling = "off",
                     jp_logo = FALSE,
                     download_data = FALSE,
                     download_image = FALSE) {

  chart_metadata <- DatawRappr::dw_retrieve_chart_metadata(chart_id)

  chart_is_compatible <- check_compatibility(chart_id)

  chart_type <- chart_is_compatible[["chart_type"]]
  chart_is_column <- stringr::str_detect(chart_type, "column")
  chart_is_bar <- stringr::str_detect(chart_type, "bars")
  chart_is_scatter <- stringr::str_detect(chart_type, "scatter")

  grid_labels_opt <- c("inside", "outside", "auto")

  grid_lines_opt <- if (chart_is_scatter) {
    c("on", "off", "just-labels", "no-labels")
  } else {
    c("on", "off", "ticks", "lines")
  }

  labeling_opt <- c("top", "right", "off")

  stopifnot(
    chart_is_compatible[["compatibility"]],
    purrr::is_character(subtitle_color),
    any(y_grid_labels == grid_labels_opt),
    any(x_grid == grid_lines_opt),
    any(y_grid == grid_lines_opt),
    any(labeling == labeling_opt),
    purrr::is_logical(jp_logo),
    purrr::is_logical(download_data),
    purrr::is_logical(download_image)
  )

  subtitle <- purrr::pluck(
    chart_metadata,
    "content",
    "metadata",
    "describe",
    "intro"
  )

  subtitle_colored <- stringr::str_replace(subtitle, "#757575", subtitle_color)

  grid_labels <- if (chart_is_column) {
    list(yAxisLabels = list(enabled = TRUE, placement = y_grid_labels))
  } else {
    list(`y-grid-labels` = y_grid_labels)
  }

  value_hover <- if (chart_is_column) {
    list(
      valueLabels = list(
        show = "hover",
        enabled = TRUE,
        placement = "inside"
      )
    )
  } else {
    list(list())
  }

  x_grid <- if (chart_is_column) {
    list(`grid-lines-x` = list(type = x_grid, enabled = TRUE))
  } else if (chart_is_scatter) {
    list(`x-grid-lines` = x_grid)
  } else {
    list(`x-grid` = x_grid)
  }

  force_grid <- if (chart_is_bar && x_grid[[1]] == "lines") {
    list(`force-grid` = TRUE)
  } else {
    list(list())
  }

  y_grid <- if (chart_is_scatter) {
    list(`y-grid-lines` = y_grid)
  } else {
    list(`y-grid` = y_grid)
  }

  y_grid_position <- purrr::pluck(
    chart_metadata,
    "content",
    "metadata",
    "visualize",
    "y-grid-label-align"
  )

  if (!is.null(y_grid_position) && y_grid_position == "right") {
    stopifnot(any(labeling == c("top", "off")))
  }

  labeling_position <- if (chart_is_column) {
    list(
      categoryLabels = list(
        enabled = if (labeling != "off") {TRUE} else {FALSE},
        position = if (labeling == "top") {"color-key"} else {"direct"}
      )
    )
  } else if (chart_is_bar) {
    list(`show-color-key` = if (labeling != "off") {TRUE} else {FALSE})
  } else {
    list(labeling = labeling)
  }

  labeling_color <- if (labeling == "right" && chart_is_column) {
    list(`use-line-color` = TRUE)
  } else if (labeling == "right" && !chart_is_column) {
    list(`label-colors` = TRUE)
  } else {
    list(list())
  }

  chart_components <- list(
    `show-tooltips` = TRUE,
    grid_labels[[1]],
    value_hover[[1]],
    x_grid[[1]],
    y_grid[[1]],
    force_grid[[1]],
    labeling_position[[1]],
    labeling_color[[1]]
  )

  names(chart_components)[2:length(chart_components)] <- names(
    c(
      grid_labels,
      value_hover,
      x_grid,
      y_grid,
      force_grid,
      labeling_position,
      labeling_color
    )
  )

  if (jp_logo) {
    jp_logo_url <- "https://www.pressdisplay.com/res/en-us/g22480/t217484168/2/images/se-jakarta_hd_logo.png"
    jp_logo_html_tags <- htmltools::tags$span(
      style = paste(
        "float:right;",
        "margin:0px;",
        "width:100px;",
        "height:12px;",
        glue::glue("background:url({jp_logo_url});"),
        "background-size:100px 12px;"
      )
    )
    jp_logo_embed <- as.character(jp_logo_html_tags)
  }

  notes_existing <- purrr::pluck(
    chart_metadata,
    "content",
    "metadata",
    "annotate",
    "notes"
  )

  notes_updated <- if (is.null(notes_existing) && jp_logo) {
    jp_logo_embed
  } else if (!is.null(notes_existing) && jp_logo) {
    jp_logo_exists <- stringr::str_detect(notes_existing, "logo")
    if (!jp_logo_exists) {
      paste(notes_existing, jp_logo_embed)
    } else {
      notes_existing
    }
  } else if (!is.null(notes_existing) && !jp_logo) {
    notes_existing
  } else {
    ""
  }

  layout_components <- list(
    blocks = list(
      `get-the-data` = download_data,
      `download-image` = download_image
    )
  )

  DatawRappr::dw_edit_chart(
    chart_id = chart_id,
    intro = subtitle_colored,
    language = "en-US",
    theme = "datawrapper",
    publish = layout_components,
    visualize = chart_components,
    annotate = notes_updated
  )

  chart_metadata_updated <- DatawRappr::dw_retrieve_chart_metadata(chart_id)

  invisible(chart_metadata_updated)

}