From mschart to native boxplots

[JanMarvin]

I have been tinkering with mschart in the past (see this PR for a second y axis: ardata-fr/mschart#84) and I'm constantly amazed how well it works and I cannot stop recommending it to people. You really really should give it a try, it's a blast, and David Gohels open source work with officer, mschart and flextable just as selected few is simply amazing.

Today I was wondering, if it would be possible to create a boxplot with mschart or ... using wb_add_mschart() and the answer is oui ! (David is French, and because I'm (still) learning French, and ... forget it). My implementation below is not perfect, partly because mschart does not support these chart extensions and openxlsx2 does not support them either (see #443). But it's a start and basically something that could be used to build upon.

The function below creates an mschart object in a workbook (this is to make sure that everything is in place) and afterwards the function replaces it with some more or less static content. It only works with a single chart, its not customizable, the style might be different, and obviously it might still fail in many cases.

library(openxlsx2)

ms_boxplot <- function(x, id = 1) {
  
  dims <- attr(x, "dims")
  
  hdr <- dims[1,]
  bdy <- paste0(dims[2,], ":", dims[nrow(dims),])
  
  header <- function(z) {
    id <- seq_along(z) - 1L
    read_xml(
      sprintf(
        '<cx:data id="%s">
     <cx:numDim type="val">
     <cx:f>%s</cx:f>
     </cx:numDim>
     </cx:data>',
        id,
        z
      ),
      pointer = FALSE)
  }
  
  data <- function(z) {
    id <- seq_along(z) - 1L
    guids <- vapply(id, FUN = function(x) openxlsx2:::st_guid(), FUN.VALUE = "")
    read_xml(
      sprintf(
        '<cx:series layoutId="boxWhisker" uniqueId="%s">
   <cx:tx>
   <cx:txData>
   <cx:f>%s</cx:f>
   <cx:v>x</cx:v>
   </cx:txData>
   </cx:tx>
   <cx:dataId val="%s" />
   <cx:layoutPr>
   <cx:visibility meanLine="0" meanMarker="1" nonoutliers="0" outliers="1" />
   <cx:statistics quartileMethod="exclusive" />
   </cx:layoutPr>
   </cx:series>',
        guids,
        z,
        id
      ),
      pointer = FALSE)
  }
  
  defn <- "_xlchart.v1."
  
  header_ids <- paste0(defn, seq_along(hdr) + id)
  data_ids   <- paste0(defn, seq_along(hdr) + length(hdr) + id)
  
  out_hdr <- hdr
  names(out_hdr) <- header_ids
  
  out_bdy <- bdy
  names(out_bdy) <- data_ids
  
  out <- sprintf(
    '<cx:chartSpace xmlns:a="http://schemas.openxmlformats.org/drawingml/2006/main" xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships" xmlns:cx="http://schemas.microsoft.com/office/drawing/2014/chartex">
   <cx:chartData>
   %s
   </cx:chartData>
   <cx:chart>
   <cx:title pos="t" align="ctr" overlay="0" />
   <cx:plotArea>
   <cx:plotAreaRegion>
   %s
   </cx:plotAreaRegion>
   <cx:axis id="0">
   <cx:catScaling gapWidth="1" />
   <cx:tickLabels />
   </cx:axis>
   <cx:axis id="1">
   <cx:valScaling />
   <cx:majorGridlines />
   <cx:tickLabels />
   </cx:axis>
   </cx:plotArea>
   </cx:chart>
   </cx:chartSpace>',
    header(data_ids),
    data(header_ids)
  ) |> read_xml(pointer = FALSE)
  attr(out, "head") <- out_hdr
  attr(out, "body") <- out_bdy
  
  out
}

wb_add_msboxplot <- function(wb, sheet = current_sheet(), dims = "A1", x) {
  
  wb <- wb$clone()
  sheet <- wb$validate_sheet(sheet)
  
  ## now we will replace the scatterplot with the chartEx from our custom
  ## xml generating function
  id <- NROW(wb$get_named_regions()) + 1L
  chart_ex <- ms_boxplot(x, id)
  
  drw_rel_id <- wb$worksheets[[sheet]]$relships$drawing
  next_rid <- "rId1"
  if (length(drw_rel_id)) {
    next_rid <- openxlsx2:::get_next_id(wb$drawings_rels[[drw_rel_id]])
  }
  
  # replace drawings and relationship
  xml <- sprintf(
    "<xdr:wsDr xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\" xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\"><xdr:absoluteAnchor>
  <mc:AlternateContent xmlns:mc=\"http://schemas.openxmlformats.org/markup-compatibility/2006\">
  <mc:Choice xmlns:cx1=\"http://schemas.microsoft.com/office/drawing/2015/9/8/chartex\" Requires=\"cx1\">
  <xdr:graphicFrame macro=\"\">
  <xdr:nvGraphicFramePr>
  <xdr:cNvPr id=\"2\" name=\"Chart 1\">
  <a:extLst><a:ext uri=\"{FF2B5EF4-FFF2-40B4-BE49-F238E27FC236}\"><a16:creationId xmlns:a16=\"http://schemas.microsoft.com/office/drawing/2014/main\" id=\"{538E2EFF-8818-17F0-6B68-3970883135F0}\"/></a:ext></a:extLst>
  </xdr:cNvPr>
  <xdr:cNvGraphicFramePr/>
  </xdr:nvGraphicFramePr>
  <xdr:xfrm><a:off x=\"0\" y=\"0\"/><a:ext cx=\"0\" cy=\"0\"/></xdr:xfrm><a:graphic><a:graphicData uri=\"http://schemas.microsoft.com/office/drawing/2014/chartex\">
  <cx:chart xmlns:cx=\"http://schemas.microsoft.com/office/drawing/2014/chartex\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" r:id=\"%s\"/>
  </a:graphicData>
  </a:graphic>
  </xdr:graphicFrame>
  </mc:Choice>
  <mc:Fallback><xdr:sp macro=\"\" textlink=\"\"><xdr:nvSpPr><xdr:cNvPr id=\"0\" name=\"\"/><xdr:cNvSpPr><a:spLocks noTextEdit=\"1\"/></xdr:cNvSpPr></xdr:nvSpPr><xdr:spPr><a:xfrm><a:off x=\"7169150\" y=\"2603500\"/><a:ext cx=\"4572000\" cy=\"2743200\"/></a:xfrm><a:prstGeom prst=\"rect\"><a:avLst/></a:prstGeom><a:solidFill><a:prstClr val=\"white\"/></a:solidFill><a:ln w=\"1\"><a:solidFill><a:prstClr val=\"green\"/></a:solidFill></a:ln></xdr:spPr><xdr:txBody><a:bodyPr vertOverflow=\"clip\" horzOverflow=\"clip\"/><a:lstStyle/><a:p><a:r><a:rPr lang=\"en-GB\" sz=\"1100\"/><a:t>This chart isn’t available in your version of Excel.\n\nEditing this shape or saving this workbook into a different file format will permanently break the chart.</a:t></a:r></a:p></xdr:txBody></xdr:sp></mc:Fallback>
  </mc:AlternateContent>
  <xdr:clientData/>
  </xdr:absoluteAnchor>
  </xdr:wsDr>",
    next_rid
  )
  wb$add_drawing(sheet = sheet, dims = dims, xml = xml)
  drw_rel_id <- wb$worksheets[[sheet]]$relships$drawing
  
  rel <- sprintf(
    "<Relationship Id=\"%s\" Type=\"http://schemas.microsoft.com/office/2014/relationships/chartEx\" Target=\"../charts/chartEx%s.xml\"/>",
    next_rid,
    length(wb$charts$chartEx) + 1L
  )
  
  if (all(wb$drawings_rels[[drw_rel_id]] == "")) {
    wb$drawings_rels[[drw_rel_id]] <- rel
  } else {
    wb$drawings_rels[[drw_rel_id]] <- append(
      wb$drawings_rels[[drw_rel_id]],
      rel
    )
  }
  
  
  id <- NROW(wb$charts) + 1L
  next_rid <- 
    
    # remove chart and relationship
    crts <- data.frame(
      chart   = "",
      colors  = openxlsx2:::colors1_xml,
      style   = openxlsx2:::styleplot_xml,
      rels    = "",
      chartEx = as.character(chart_ex),
      relsEx  = sprintf(
        "<Relationships xmlns=\"http://schemas.openxmlformats.org/package/2006/relationships\">
    <Relationship Id=\"rId2\" Type=\"http://schemas.microsoft.com/office/2011/relationships/chartColorStyle\" Target=\"colors%s.xml\"/>
    <Relationship Id=\"rId1\" Type=\"http://schemas.microsoft.com/office/2011/relationships/chartStyle\" Target=\"style%s.xml\"/>
    </Relationships>",
        id,
        id
      )
    )
  
  wb$charts <- rbind(wb$charts, crts)
  
  # wb$worksheets[[sheet]]$relships
  
  # we need named regions for the header and data for the chartEx
  for (i in seq_along(attr(chart_ex, "head"))) {
    dn <- attr(chart_ex, "head")[i]
    wb$add_named_region(
      sheet = attr(x, "sheet"),
      dims = as.character(dn),
      name = names(dn),
      hidden = "1"
    )  
  }
  
  for (i in seq_along(attr(chart_ex, "body"))) {
    dn <- attr(chart_ex, "body")[i]
    wb$add_named_region(
      sheet = attr(x, "sheet"),
      dims = as.character(dn),
      name = names(dn),
      hidden = "1"
    )  
  }
  
  rm(i, dn)
  
  wb
}


library(openxlsx2)
library(mschart)
#> 
#> Attaching package: 'mschart'
#> The following object is masked _by_ '.GlobalEnv':
#> 
#>     ms_boxplot

wb <- wb_workbook()$
  add_worksheet()$
  add_worksheet()$add_data(x = mtcars)$
  add_worksheet()$add_data(x = iris)

# create wb_data object
dat1 <- wb_data(wb, sheet = 2)
dat2 <- wb_data(wb, sheet = 3)

wb <- wb %>% 
  wb_add_msboxplot(sheet = "Sheet 1", dims = "A1:G10", x = dat1) %>% 
  wb_add_msboxplot(sheet = "Sheet 1", dims = "A11:E20", x = dat2)

if (interactive()) wb$open()