Skip to content

Commit

Permalink
Add support to set chart and plot area color and border
Browse files Browse the repository at this point in the history
* Add functionality to set background fill color and border of chart and plot area.
* Add theme_ggplot2() and chart_fill_ggplot2().
  • Loading branch information
trekonom authored Apr 26, 2024
1 parent da9fb75 commit 944c6d5
Show file tree
Hide file tree
Showing 10 changed files with 251 additions and 6 deletions.
19 changes: 14 additions & 5 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -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",
Expand All @@ -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
Expand Down
2 changes: 2 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
Expand Down
9 changes: 8 additions & 1 deletion R/ms_chart.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand Down Expand Up @@ -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"))
}
Expand Down
36 changes: 36 additions & 0 deletions R/sppr_codes.R
Original file line number Diff line number Diff line change
@@ -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
}
26 changes: 26 additions & 0 deletions R/theme.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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"))
Expand All @@ -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")
Expand All @@ -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"
Expand All @@ -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))) {
Expand Down Expand Up @@ -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))
Expand Down
79 changes: 79 additions & 0 deletions R/themes.R
Original file line number Diff line number Diff line change
@@ -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
}
34 changes: 34 additions & 0 deletions man/chart_fill_ggplot2.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Binary file added man/figures/fig_theme_ggplot2.png
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
16 changes: 16 additions & 0 deletions man/set_theme.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

36 changes: 36 additions & 0 deletions man/theme_ggplot2.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 944c6d5

Please sign in to comment.