diff --git a/DESCRIPTION b/DESCRIPTION index 0ddac56..075a609 100644 --- a/DESCRIPTION +++ b/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 = "david.gohel@ardata.fr"), 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 = 'moogs@gmx.de', comment = "support to set chart and plot area color and border"), + person("Eli", "Daniels", role = "ctb", email = 'eli.daniels@ardata.fr'), 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 diff --git a/NAMESPACE b/NAMESPACE index 5aa7fe7..22620b6 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/ms_chart.R b/R/ms_chart.R index 5e56c71..61d5143 100644 --- a/R/ms_chart.R +++ b/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("", str_, x_axis_str, y_axis_str, table_str, "") + xml_elt <- paste0("", str_, x_axis_str, y_axis_str, table_str, sppr_str, "") 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")) } diff --git a/R/sppr_codes.R b/R/sppr_codes.R new file mode 100644 index 0000000..d50042b --- /dev/null +++ b/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( + "", + 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( + "", + fill_str, + border_str, + "" + ) + + sppr_str +} diff --git a/R/theme.R b/R/theme.R index 045f38b..3db33fa 100644 --- a/R/theme.R +++ b/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)) diff --git a/R/themes.R b/R/themes.R new file mode 100644 index 0000000..2551a55 --- /dev/null +++ b/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 +} diff --git a/man/chart_fill_ggplot2.Rd b/man/chart_fill_ggplot2.Rd new file mode 100644 index 0000000..e8c497f --- /dev/null +++ b/man/chart_fill_ggplot2.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/themes.R +\name{chart_fill_ggplot2} +\alias{chart_fill_ggplot2} +\title{Apply ggplot2 color scale} +\usage{ +chart_fill_ggplot2(x, stroke = TRUE) +} +\arguments{ +\item{x}{a mschart object} + +\item{stroke}{a boolean. Apply the color scale to stroke? Defaults to \code{TRUE}.} +} +\value{ +a mschart object +} +\description{ +The default hue color scale from ggplot2. +} +\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) +} diff --git a/man/figures/fig_theme_ggplot2.png b/man/figures/fig_theme_ggplot2.png new file mode 100644 index 0000000..0a2d070 Binary files /dev/null and b/man/figures/fig_theme_ggplot2.png differ diff --git a/man/set_theme.Rd b/man/set_theme.Rd index cde07c9..edb3761 100644 --- a/man/set_theme.Rd +++ b/man/set_theme.Rd @@ -30,6 +30,10 @@ mschart_theme( 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", @@ -54,6 +58,10 @@ chart_theme( 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, @@ -84,6 +92,14 @@ chart_theme( \item{grid_minor_line, grid_minor_line_x, grid_minor_line_y}{minor grid lines formatting properties (see \code{\link[=fp_border]{fp_border()}})} +\item{chart_background}{chart area background fill color - single character value (e.g. "#000000" or "black")} + +\item{chart_border}{chart area border lines formatting properties (see \code{\link[=fp_border]{fp_border()}})} + +\item{plot_background}{plot area background fill color - single character value (e.g. "#000000" or "black")} + +\item{plot_border}{plot area border lines formatting properties (see \code{\link[=fp_border]{fp_border()}})} + \item{date_fmt}{date format} \item{str_fmt}{string or factor format} diff --git a/man/theme_ggplot2.Rd b/man/theme_ggplot2.Rd new file mode 100644 index 0000000..d62b6cb --- /dev/null +++ b/man/theme_ggplot2.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/themes.R +\name{theme_ggplot2} +\alias{theme_ggplot2} +\title{Apply ggplot2 theme} +\usage{ +theme_ggplot2(x, base_size = 11, base_family = "Arial") +} +\arguments{ +\item{x}{a mschart object} + +\item{base_size}{base font size} + +\item{base_family}{font family} +} +\value{ +a mschart object +} +\description{ +A theme that approximates the style of ggplot2::theme_grey. +} +\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) +}