Add support to set chart and plot area color and border

* Add functionality to set background fill color and border of chart and plot area.
* Add theme_ggplot2() and chart_fill_ggplot2().

Author: trekonom

DESCRIPTION

@@ -1,13 +1,15 @@
 Package: mschart
 Type: Package
 Title: Chart Generation for 'Microsoft Word' and 'Microsoft PowerPoint' Documents
-Version: 0.4.1.001
+Version: 0.4.1.002
 Authors@R: c(
     person("David", "Gohel", role = c("aut", "cre"), 
       email = "[email protected]"),
     person(given = "ArData", role = "cph"),
     person("YouGov", role = "fnd"),
     person("Jan Marvin", "Garbuszus", role = "ctb", comment = "support for openxls2"),
+    person("Stefan", "Moog", role = "ctb", email = '[email protected]', comment = "support to set chart and plot area color and border"),
+    person("Eli", "Daniels", role = "ctb", email = '[email protected]'),
     person("Marlon", "Molina", role = "ctb", comment = "added table feature"),
     person("Rokas", "Klydzia", role = "ctb", comment = "custom labels"),
     person("David", "Camposeco", role = "ctb", 
@@ -25,10 +27,17 @@ License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 Depends: R (>= 2.10)
-Imports: stats, data.table,
- officer (>= 0.3.6), cellranger,
- writexl, grDevices, xml2 (>= 1.1.0),
- htmltools, utils
+Imports: 
+    stats,
+    data.table,
+    officer (>= 0.3.6),
+    cellranger,
+    writexl,
+    grDevices,
+    xml2 (>= 1.1.0),
+    htmltools,
+    utils,
+    scales
 URL: https://ardata-fr.github.io/officeverse/, https://ardata-fr.github.io/mschart/
 BugReports: https://github.com/ardata-fr/mschart/issues
 RoxygenNote: 7.3.1

NAMESPACE

@@ -19,6 +19,7 @@ export(chart_data_size)
 export(chart_data_smooth)
 export(chart_data_stroke)
 export(chart_data_symbol)
+export(chart_fill_ggplot2)
 export(chart_labels)
 export(chart_labels_text)
 export(chart_settings)
@@ -30,6 +31,7 @@ export(ms_linechart)
 export(ms_scatterchart)
 export(mschart_theme)
 export(set_theme)
+export(theme_ggplot2)
 importFrom(cellranger,as.cell_limits)
 importFrom(cellranger,as.range)
 importFrom(cellranger,cell_limits)

R/ms_chart.R

@@ -405,8 +405,10 @@ format.ms_chart <- function(x, id_x, id_y, sheetname = "sheet1", drop_ext_data =
 
   table_str <- table_content_xml(x)
 
+  sppr_str <- sppr_content_xml(x$theme, "plot")
+
   ns <- "xmlns:c=\"http://schemas.openxmlformats.org/drawingml/2006/chart\" xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\""
-  xml_elt <- paste0("<c:plotArea ", ns, "><c:layout/>", str_, x_axis_str, y_axis_str, table_str, "</c:plotArea>")
+  xml_elt <- paste0("<c:plotArea ", ns, "><c:layout/>", str_, x_axis_str, y_axis_str, table_str, sppr_str, "</c:plotArea>")
   xml_doc <- read_xml(system.file(package = "mschart", "template", "chart.xml"))
 
   node <- xml_find_first(xml_doc, "//c:plotArea")
@@ -436,6 +438,11 @@ format.ms_chart <- function(x, id_x, id_y, sheetname = "sheet1", drop_ext_data =
     legend_ <- xml_find_first(xml_doc, "//c:chart/c:legend")
     xml_add_child(legend_, as_xml_document(labels_text_pr))
   }
+
+  chart_area_node <- xml_find_first(xml_doc, "//c:chartSpace")
+  chart_area_properties <- sppr_content_xml(x$theme, what = "chart", ns = ns)
+  xml_add_child(chart_area_node, as_xml_document(chart_area_properties))
+
   if (drop_ext_data) {
     xml_remove(xml_find_first(xml_doc, "//c:externalData"))
   }

R/sppr_codes.R

@@ -0,0 +1,36 @@
+#' @title xml code for chart and plot area properties
+#' @param theme an object of class mschart_theme
+#' @param what a character. One of `"plot"` or `"chart"`
+#' @noRd
+sppr_content_xml <- function(theme = NULL, what = "chart", ns = NULL) {
+  if (!what %in% c("plot", "chart")) {
+    stop("what sould be one of \"plot\" or \"chart\"")
+  }
+
+  fill <- theme[[paste0(what, "_background")]]
+  border_properties <- theme[[paste0(what, "_border")]]
+
+  if (!is.null(fill)) {
+    fill_elts <- col2rgb(fill, alpha = TRUE)[, 1]
+    fill_hex <- sprintf("%02X%02X%02X", fill_elts[1], fill_elts[2], fill_elts[3])
+    fill_str <- sprintf(
+      "<a:solidFill><a:srgbClr val=\"%s\"><a:alpha val=\"%.0f\"/></a:srgbClr></a:solidFill>",
+      fill_hex, fill_elts[4] / 255.0 * 100000
+    )
+  } else {
+    fill_str <- NULL
+  }
+
+  border_str <- ooxml_fp_border(border_properties)
+
+  if (!is.null(ns)) ns <- paste0(" ", ns)
+
+  sppr_str <- paste0(
+    "<c:spPr", ns, ">",
+    fill_str,
+    border_str,
+    "</c:spPr>"
+  )
+
+  sppr_str
+}

R/theme.R

@@ -48,6 +48,10 @@ set_theme <- function(x, value) {
 #' @param axis_ticks,axis_ticks_x,axis_ticks_y axis ticks formatting properties (see [fp_border()])
 #' @param grid_major_line,grid_major_line_x,grid_major_line_y major grid lines formatting properties (see [fp_border()])
 #' @param grid_minor_line,grid_minor_line_x,grid_minor_line_y minor grid lines formatting properties (see [fp_border()])
+#' @param plot_border plot area border lines formatting properties (see [fp_border()])
+#' @param chart_border chart area border lines formatting properties (see [fp_border()])
+#' @param plot_background plot area background fill color - single character value (e.g. "#000000" or "black")
+#' @param chart_background chart area background fill color - single character value (e.g. "#000000" or "black")
 #' @param date_fmt date format
 #' @param str_fmt string or factor format
 #' @param double_fmt double format
@@ -65,6 +69,8 @@ mschart_theme <- function(axis_title = fp_text(bold = TRUE, font.size = 16), axi
                           axis_ticks = fp_border(color = "#99999999"), axis_ticks_x = axis_ticks, axis_ticks_y = axis_ticks,
                           grid_major_line = fp_border(color = "#99999999", style = "dashed"), grid_major_line_x = grid_major_line, grid_major_line_y = grid_major_line,
                           grid_minor_line = fp_border(width = 0), grid_minor_line_x = grid_minor_line, grid_minor_line_y = grid_minor_line,
+                          chart_background = NULL, chart_border = fp_border(color = "transparent"),
+                          plot_background = NULL, plot_border = fp_border(color = "transparent"),
                           date_fmt = "yyyy/mm/dd", str_fmt = "General", double_fmt = "#,##0.00", integer_fmt = "0", legend_position = "b") {
   stopifnot(inherits(main_title, "fp_text"))
   stopifnot(inherits(table_text, "fp_text"))
@@ -84,6 +90,8 @@ mschart_theme <- function(axis_title = fp_text(bold = TRUE, font.size = 16), axi
   stopifnot(inherits(grid_minor_line, "fp_border"))
   stopifnot(inherits(grid_minor_line_x, "fp_border"))
   stopifnot(inherits(grid_minor_line_y, "fp_border"))
+  stopifnot(inherits(chart_border, "fp_border"))
+  stopifnot(inherits(plot_border, "fp_border"))
 
   if (title_rot < 0 && title_rot > 359) {
     stop("title_rot must be between 0 and 359")
@@ -110,6 +118,8 @@ mschart_theme <- function(axis_title = fp_text(bold = TRUE, font.size = 16), axi
     axis_ticks_x = axis_ticks_x, axis_ticks_y = axis_ticks_y,
     grid_major_line_x = grid_major_line_x, grid_major_line_y = grid_major_line_y,
     grid_minor_line_x = grid_minor_line_x, grid_minor_line_y = grid_minor_line_y,
+    chart_background = chart_background, chart_border = chart_border,
+    plot_background = plot_background, plot_border = plot_border,
     legend_position = legend_position
   )
   class(out) <- "mschart_theme"
@@ -125,6 +135,8 @@ chart_theme <- function(x, axis_title_x, axis_title_y, main_title, legend_text,
                         axis_ticks_x, axis_ticks_y,
                         grid_major_line_x, grid_major_line_y,
                         grid_minor_line_x, grid_minor_line_y,
+                        chart_background, chart_border,
+                        plot_background, plot_border,
                         date_fmt, str_fmt, double_fmt, integer_fmt, legend_position) {
   if (!missing(axis_title_x)) {
     if (!all(class(axis_title_x) %in% class(x$theme$axis_title_x))) {
@@ -210,6 +222,20 @@ chart_theme <- function(x, axis_title_x, axis_title_y, main_title, legend_text,
     x$theme$grid_minor_line_y <- grid_minor_line_y
   }
 
+  if (!missing(chart_border)) {
+    if (!all(class(chart_border) %in% class(x$theme$chart_border))) {
+      stop("chart_border should be of class ", class(x$theme$chart_border))
+    }
+    x$theme$chart_border <- chart_border
+  }
+
+  if (!missing(plot_border)) {
+    if (!all(class(plot_border) %in% class(x$theme$plot_border))) {
+      stop("plot_border should be of class ", class(x$theme$plot_border))
+    }
+    x$theme$plot_border <- plot_border
+  }
+
   if (!missing(date_fmt)) {
     if (!all(class(date_fmt) %in% class(x$theme$date_fmt))) {
       stop("date_fmt should be of class ", class(x$theme$date_fmt))

R/themes.R

@@ -0,0 +1,79 @@
+#' Apply ggplot2 theme
+#'
+#' A theme that approximates the style of ggplot2::theme_grey.
+#'
+#' @param x a mschart object
+#' @param base_size base font size
+#' @param base_family font family
+#'
+#' @return a mschart object
+#'
+#' @export
+#'
+#' @section theme_ggplot2():
+#'
+#' \if{html}{\figure{fig_theme_ggplot2.png}{options: width="500"}}
+#'
+#' @examples
+#' p <- ms_scatterchart(
+#'   data = iris, x = "Sepal.Length",
+#'   y = "Sepal.Width", group = "Species"
+#' )
+#'
+#' p <- theme_ggplot2(p)
+#' p <- chart_fill_ggplot2(p)
+theme_ggplot2 <- function(x, base_size = 11, base_family = "Arial") {
+  t <- mschart_theme(
+    main_title = fp_text(color = "black", font.size = 1.2 * base_size, font.family = base_family),
+    axis_title = fp_text(color = "black", font.size = base_size, font.family = base_family),
+    axis_text = fp_text(color = "grey30", font.size = .8 * base_size, font.family = base_family),
+    axis_ticks = fp_border(color = "grey20", width = 1, style = "solid"),
+    grid_major_line_x = fp_border(color = "white", width = 1, style = "solid"),
+    grid_major_line_y = fp_border(color = "white", width = 1, style = "solid"),
+    grid_minor_line_x = fp_border(color = "white", width = .5, style = "solid"),
+    grid_minor_line_y = fp_border(color = "white", width = .5, style = "solid"),
+    chart_background = "white",
+    plot_background = "grey92",
+    legend_text = fp_text(color = "black", font.size = base_size, font.family = base_family),
+    legend_position = "r"
+  )
+  set_theme(x, t)
+}
+
+#' Apply ggplot2 color scale
+#'
+#' The default hue color scale from ggplot2.
+#'
+#' @param x a mschart object
+#' @param stroke a boolean. Apply the color scale to stroke? Defaults to `TRUE`.
+#'
+#' @return a mschart object
+#'
+#' @export
+#'
+#' @section chart_fill_ggplot2():
+#'
+#' \if{html}{\figure{fig_theme_ggplot2.png}{options: width="500"}}
+#'
+#' @examples
+#' p <- ms_scatterchart(
+#'   data = iris, x = "Sepal.Length",
+#'   y = "Sepal.Width", group = "Species"
+#' )
+#'
+#' p <- theme_ggplot2(p)
+#' p <- chart_fill_ggplot2(p)
+chart_fill_ggplot2 <- function(x, stroke = TRUE) {
+  if (!is.null(x$group)) {
+    groups <- unique(x$data[[x$group]])
+    ngroups <- length(groups)
+    pal <- scales::hue_pal()(ngroups)
+    names(pal) <- groups
+  } else {
+    pal <- scales::hue_pal()(1)
+  }
+
+  x <- chart_data_fill(x, values = pal)
+  if (stroke) x <- chart_data_stroke(x, values = pal)
+  x
+}