Merge branch 'master' into pie_chart

ardata-fr · Apr 26, 2024 · e9e2a7f · e9e2a7f
2 parents 5bccc74 + b69fbf6
commit e9e2a7f
Show file tree

Hide file tree

Showing 49 changed files with 635 additions and 356 deletions.
diff --git 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.0.002
+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,12 +27,19 @@ 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.2.2
+RoxygenNote: 7.3.1
 Roxygen: list(markdown = TRUE)
-Suggests: tinytest
+Suggests: tinytest, doconv
diff --git a/NAMESPACE b/NAMESPACE
@@ -20,6 +20,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)
@@ -32,11 +33,14 @@ export(ms_piechart)
 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)
 importFrom(cellranger,ra_ref)
 importFrom(cellranger,to_string)
+importFrom(data.table,":=")
+importFrom(data.table,.N)
 importFrom(data.table,as.data.table)
 importFrom(data.table,dcast.data.table)
 importFrom(data.table,rbindlist)
@@ -56,6 +60,7 @@ importFrom(officer,ph_with)
 importFrom(officer,read_pptx)
 importFrom(officer,styles_info)
 importFrom(officer,to_pml)
+importFrom(scales,hue_pal)
 importFrom(stats,as.formula)
 importFrom(stats,setNames)
 importFrom(stats,update)

diff --git a/NEWS.md b/NEWS.md
@@ -1,8 +1,29 @@
+# mschart 0.4.1
+
+## Issues
+
+* fix issue with dcast by making sure all data are preserved.
+
+## New features
+
+* Add support to set chart and plot area color and border by Stefan Moog ;
+added four new theme arguments chart/plot_background and chart/plot_border, 
+new theme `theme_ggplot2()`.
+
+
+
 # mschart 0.4.0
 
 ## New features
 
 * Support for openxlsx2 by Jan Marvin Garbuszus
+* option to add table of data below corresponding levels by Marlon Molina
+
+## Issues
+
+* fix issue with % in labels of the graphic
+* stop reordering data when a group is used, user is expected to 
+do it before sending the data to mschart.
 
 # mschart 0.3.1
 

diff --git a/R/as_series.R b/R/as_series.R
@@ -20,16 +20,18 @@ series_wb_data <- function(dataset, idx) {
   serie_range
 }
 
-as_series <- function(x, x_class, y_class, sheetname = "sheet1" ){
+as_series <- function(x, x_class, y_class, sheetname = "sheet1") {
   dataset <- x$data_series
 
-  w_x <- which( names(dataset) %in% x$xvar )
+  w_x <- which(names(dataset) %in% x$xvar)
 
-  x_serie_range <- cell_limits(ul = c(2, w_x),
-                               lr = c(nrow(dataset)+1, w_x),
-                               sheet = sheetname)
+  x_serie_range <- cell_limits(
+    ul = c(2, w_x),
+    lr = c(nrow(dataset) + 1, w_x),
+    sheet = sheetname
+  )
 
-  if (inherits(dataset, "wb_data")){
+  if (inherits(dataset, "wb_data")) {
     x_serie_range <- series_wb_data(dataset, w_x)
   }
 
@@ -38,8 +40,9 @@ as_series <- function(x, x_class, y_class, sheetname = "sheet1" ){
 
   label_columns <- get_label_names(x)
 
-  if (inherits(dataset, "wb_data"))
+  if (inherits(dataset, "wb_data")) {
     label_columns <- x$label_cols
+  }
 
   series <- list()
 
@@ -63,45 +66,48 @@ as_series <- function(x, x_class, y_class, sheetname = "sheet1" ){
 
     serie_name_range <- ra_ref(row_ref = 1, col_ref = w_y, sheet = sheetname)
     serie_name_range <- to_string(serie_name_range, fo = "A1")
-    if (inherits(dataset, "wb_data")){
+    if (inherits(dataset, "wb_data")) {
       serie_name_range <- series_wb_name(dataset, w_y)
       serie_name_range <- as.range(serie_name_range, fo = "A1", strict = TRUE, sheet = TRUE)
     }
     serie_name <- str_ref(values = y_colname, region = serie_name_range)
 
-    y_serie_range <- cell_limits(ul = c(2, w_y), lr = c(nrow(dataset)+1, w_y),  sheet = sheetname)
+    y_serie_range <- cell_limits(ul = c(2, w_y), lr = c(nrow(dataset) + 1, w_y), sheet = sheetname)
 
-    if (inherits(dataset, "wb_data")){
+    if (inherits(dataset, "wb_data")) {
       y_serie_range <- series_wb_data(dataset, w_y)
     }
     y_serie_range <- as.range(y_serie_range, fo = "A1", strict = TRUE, sheet = TRUE)
 
     y_serie <- update(y_class, region = y_serie_range, values = dataset[[y_colname]])
 
-    if(length(label_columns) > 0 ){
-      label_serie_range <- cell_limits(ul = c(2, w_l), lr = c(nrow(dataset)+1, w_l),  sheet = sheetname)
+    if (length(label_columns) > 0) {
+      label_serie_range <- cell_limits(ul = c(2, w_l), lr = c(nrow(dataset) + 1, w_l), sheet = sheetname)
       label_serie_range <- as.range(label_serie_range, fo = "A1", strict = TRUE, sheet = TRUE)
 
-      if (inherits(dataset, "wb_data")){
+      if (inherits(dataset, "wb_data")) {
         label_serie_range <- series_wb_data(dataset, w_l)
         label_serie_range <- as.range(label_serie_range, fo = "A1", strict = TRUE, sheet = TRUE)
       }
       label_serie <- label_ref(values = dataset[[l_colname]], region = label_serie_range)
-    } else label_serie <- NULL
-
-    ser <- list( idx = length(series), order = length(series),
-                 tx = serie_name,
-                 x = x_serie, y = y_serie, label = label_serie,
-                 stroke = x$series_settings$colour[y_colname],
-                 fill = x$series_settings$fill[y_colname],
-                 symbol = x$series_settings$symbol[y_colname],
-                 line_style = x$series_settings$line_style[y_colname],
-                 size = x$series_settings$size[y_colname],
-                 line_width = x$series_settings$line_width[y_colname],
-                 labels_fp = x$series_settings$labels_fp[[y_colname]],
-                 smooth = x$series_settings$smooth[y_colname]
+    } else {
+      label_serie <- NULL
+    }
+
+    ser <- list(
+      idx = length(series), order = length(series),
+      tx = serie_name,
+      x = x_serie, y = y_serie, label = label_serie,
+      stroke = x$series_settings$colour[y_colname],
+      fill = x$series_settings$fill[y_colname],
+      symbol = x$series_settings$symbol[y_colname],
+      line_style = x$series_settings$line_style[y_colname],
+      size = x$series_settings$size[y_colname],
+      line_width = x$series_settings$line_width[y_colname],
+      labels_fp = x$series_settings$labels_fp[[y_colname]],
+      smooth = x$series_settings$smooth[y_colname]
     )
-    series <- append(series, list(ser) )
+    series <- append(series, list(ser))
   }
   series
 }
diff --git a/R/axis_codes.R b/R/axis_codes.R
@@ -27,15 +27,14 @@ get_axis_tag <- function(x){
 #' @param is_x if TRUE, generate xml for x axis, else for y axis
 #' @param lab label for the axis
 #' @param rot rotation of title
-axis_content_xml <- function(x, id, cross_id, theme, is_x = TRUE, lab = NULL, rot = 0 ){
-
+axis_content_xml <- function(x, id, cross_id, theme, is_x = TRUE, lab = NULL, rot = 0) {
   x_title_id <- paste0("axis_title_", ifelse(is_x, "x", "y"))
 
-  if( is.null(lab)) {
+  if (is.null(lab)) {
     title_ <- ""
   } else {
     title_ <- "<c:title><c:tx><c:rich><a:bodyPr rot=\"%.0f\" vert=\"horz\" anchor=\"ctr\"/><a:lstStyle/><a:p><a:pPr><a:defRPr/></a:pPr><a:r>%s<a:t>%s</a:t></a:r></a:p></c:rich></c:tx><c:layout/><c:overlay val=\"0\"/></c:title>"
-    title_ <- sprintf(title_, rot * 60000 , format(theme[[x_title_id]], type = "pml" ), lab )
+    title_ <- sprintf(title_, rot * 60000, format(theme[[x_title_id]], type = "pml"), lab)
   }
 
   major_tm <- "<c:majorTickMark val=\"%s\"/>"
@@ -46,38 +45,44 @@ axis_content_xml <- function(x, id, cross_id, theme, is_x = TRUE, lab = NULL, ro
 
   grid_major_id <- paste0("grid_major_line_", ifelse(is_x, "x", "y"))
   major_gl <- ooxml_fp_border(theme[[grid_major_id]],
-                                in_tags = c("c:majorGridlines", "c:spPr"))
+    in_tags = c("c:majorGridlines", "c:spPr")
+  )
 
   grid_minor_id <- paste0("grid_minor_line_", ifelse(is_x, "x", "y"))
   minor_gl <- ooxml_fp_border(theme[[grid_minor_id]],
-                              in_tags = c("c:minorGridlines", "c:spPr"))
+    in_tags = c("c:minorGridlines", "c:spPr")
+  )
 
   lim_max <- ""
-  if( !is.null(x$limit_max) )
-    lim_max <- sprintf("<c:max val=\"%.02f\"/>", x$limit_max )
+  if (!is.null(x$limit_max)) {
+    lim_max <- sprintf("<c:max val=\"%.02f\"/>", x$limit_max)
+  }
   lim_min <- ""
-  if( !is.null(x$limit_min) )
-    lim_min <- sprintf("<c:min val=\"%.02f\"/>", x$limit_min )
+  if (!is.null(x$limit_min)) {
+    lim_min <- sprintf("<c:min val=\"%.02f\"/>", x$limit_min)
+  }
 
-  scaling_str <- sprintf("<c:scaling><c:orientation val=\"%s\"/>%s%s</c:scaling>", x$orientation, lim_max, lim_min )
-  delete <- sprintf("<c:delete val=\"%.0f\"/>", x$delete )
-  position <- sprintf("<c:axPos val=\"%s\"/>", x$axis_position )
-  crosses <- sprintf("<c:crosses val=\"%s\"/>", x$crosses )
+  scaling_str <- sprintf("<c:scaling><c:orientation val=\"%s\"/>%s%s</c:scaling>", x$orientation, lim_max, lim_min)
+  delete <- sprintf("<c:delete val=\"%.0f\"/>", x$delete)
+  position <- sprintf("<c:axPos val=\"%s\"/>", x$axis_position)
+  crosses <- sprintf("<c:crosses val=\"%s\"/>", x$crosses)
 
   lim_max <- ""
-  if( !is.null(x$limit_max) )
-    lim_max <- sprintf("<c:max val=\"%.02f\"/>", x$limit_max )
+  if (!is.null(x$limit_max)) {
+    lim_max <- sprintf("<c:max val=\"%.02f\"/>", x$limit_max)
+  }
   lim_min <- ""
-  if( !is.null(x$limit_min) )
-    lim_min <- sprintf("<c:min val=\"%.02f\"/>", x$limit_min )
+  if (!is.null(x$limit_min)) {
+    lim_min <- sprintf("<c:min val=\"%.02f\"/>", x$limit_min)
+  }
   cross_at <- ""
-  if( !is.null(x$position) ){
-    cross_at <- sprintf("<c:crossesAt val=\"%.02f\"/>", x$position )
+  if (!is.null(x$position)) {
+    cross_at <- sprintf("<c:crossesAt val=\"%.02f\"/>", x$position)
     crosses <- ""
   }
 
   num_fmt <- ""
-  if( !is.null(x$num_fmt) ){
+  if (!is.null(x$num_fmt)) {
     num_fmt <- sprintf("<c:numFmt formatCode=\"%s\" sourceLinked=\"0\"/>", x$num_fmt)
   }
 
@@ -88,27 +93,28 @@ axis_content_xml <- function(x, id, cross_id, theme, is_x = TRUE, lab = NULL, ro
 
   axis_major_ticks_id <- paste0("axis_ticks_", ifelse(is_x, "x", "y"))
   axis_ticks <- ooxml_fp_border(theme[[axis_major_ticks_id]],
-                              in_tags = c("c:spPr"))
+    in_tags = c("c:spPr")
+  )
 
 
   labels_text_id <- paste0("axis_text_", ifelse(is_x, "x", "y"))
   rpr <- format(theme[[labels_text_id]], type = "pml")
   rpr <- gsub("a:rPr", "a:defRPr", rpr)
   labels_text_pr <- "<c:txPr><a:bodyPr rot=\"%.0f\" vert=\"horz\"/><a:lstStyle/><a:p><a:pPr>%s</a:pPr></a:p></c:txPr>"
-  labels_text_pr <- sprintf(labels_text_pr, x$rotation * 60000, rpr )
-
-  str_ <- paste0( "<c:axId val=\"%s\"/>",
-                  scaling_str, delete, position,
-                  major_gl, minor_gl,
-                  title_,
-                  major_tm, minor_tm, tl_pos,
-                  labels_text_pr,
-                  axis_ticks, num_fmt,
-                  "<c:crossAx val=\"%s\"/>",
-                  cross_at,
-                  crosses)
-  str_ <- sprintf(str_, id, cross_id)
+  labels_text_pr <- sprintf(labels_text_pr, x$rotation * 60000, rpr)
+
+  str_ <- paste0(
+    sprintf("<c:axId val=\"%s\"/>", id),
+    scaling_str, delete, position,
+    major_gl, minor_gl,
+    title_,
+    major_tm, minor_tm, tl_pos,
+    labels_text_pr,
+    axis_ticks, num_fmt,
+    sprintf("<c:crossAx val=\"%s\"/>", cross_id),
+    cross_at,
+    crosses
+  )
   str_
-
 }