[reland] cleanup column width and font size setting

NEWS.md

@@ -14,6 +14,8 @@
 
 ## Fixes
 
+* Improvements to setting column widths. Previously values set by `set_col_widths()` were a little off. This has now been improved. There are still corner cases where the column width set with `openxlsx2` does not match those shown in spreadsheet software. Notable differences can be seen with floating point values (e.g., `10L` works while `10.1` is slightly off) and with column width on Mac. [350](https://github.com/JanMarvin/openxlsx2/pull/350)
+
 * Improve `rowNames` when writing data to worksheet. Previously the name for the rownames column defaulted to `1`. This has been changed. Now with data it defaults to an empty cell and with a data table it defaults to `_rowNames_`. [375](https://github.com/JanMarvin/openxlsx2/pull/375)
 
 * Fix the workbook xml relationship file to not include a reference to shared strings per default. This solves [360](https://github.com/JanMarvin/openxlsx2/issues/360) for plain data files written from `openxlsx2`. [363](https://github.com/JanMarvin/openxlsx2/pull/363)

R/baseXML.R

@@ -137,7 +137,7 @@ genBaseStyleSheet <- function(dxfs = NULL, tableStyles = NULL, extLst = NULL) {
   list(
     numFmts = NULL,
 
-    fonts = c('<font><sz val="11"/><color rgb="FF000000"/><name val="Calibri"/><family val="2"/><scheme val="minor"/></font>'),
+    fonts = c('<font><sz val="11"/><color theme="1"/><name val="Calibri"/><family val="2"/><scheme val="minor"/></font>'),
 
     fills = c(
       '<fill><patternFill patternType="none"/></fill>',

R/class-workbook-wrappers.R

@@ -788,7 +788,7 @@ wb_remove_worksheet <- function(wb, sheet = current_sheet()) {
 #'
 #' wb$add_data("S1", iris)
 #' wb$add_data_table("S1", x = iris, startCol = 10) ## font colour does not affect tables
-wb_set_base_font <- function(wb, fontSize = 11, fontColour = "black", fontName = "Calibri") {
+wb_set_base_font <- function(wb, fontSize = 11, fontColour = wb_colour(theme = "1"), fontName = "Calibri") {
   assert_workbook(wb)
   wb$clone()$set_base_font(
     fontSize   = fontSize,

R/class-workbook.R

@@ -1863,7 +1863,7 @@ wbWorkbook <- R6::R6Class(
       name   <- unlist(xml_attr(baseFont, "font", "name"))
 
       if (length(sz[[1]]) == 0) {
-        sz <- list("val" = "10")
+        sz <- list("val" = "11")
       } else {
         sz <- as.list(sz)
       }
@@ -1893,16 +1893,10 @@ wbWorkbook <- R6::R6Class(
     #' @param fontColour fontColour
     #' @param fontName fontName
     #' @return The `wbWorkbook` object
-    set_base_font = function(fontSize = 11, fontColour = "black", fontName = "Calibri") {
+    set_base_font = function(fontSize = 11, fontColour = wb_colour(theme = "1"), fontName = "Calibri") {
       if (fontSize < 0) stop("Invalid fontSize")
-      fontColour <- validateColour(fontColour)
-
-      self$styles_mgr$styles$fonts[[1]] <- sprintf(
-        '<font><sz val="%s"/><color rgb="%s"/><name val="%s"/></font>',
-        fontSize,
-        fontColour,
-        fontName
-      )
+      if (is.character(fontColour) && is.null(names(fontColour))) fontColour <- wb_colour(fontColour)
+      self$styles_mgr$styles$fonts[[1]] <- create_font(sz = as.character(fontSize), color = fontColour, name = fontName)
     },
 
     ### sheet names ----
@@ -2248,43 +2242,22 @@ wbWorkbook <- R6::R6Class(
 
       ## Remove duplicates
       ok <- !duplicated(cols)
-      widths <- widths[ok]
+      col_width <- widths[ok]
       hidden <- hidden[ok]
       cols <- cols[ok]
 
       col_df <- self$worksheets[[sheet]]$unfold_cols()
+      base_font <- wb_get_base_font(self)
 
       if (any(widths == "auto")) {
-
         df <- wb_to_df(self, sheet = sheet, cols = cols, colNames = FALSE)
         # TODO format(x) might not be the way it is formatted in the xlsx file.
         col_width <- vapply(df, function(x) max(nchar(format(x))), NA_real_)
+      }
 
-        # message() should be used instead if we really needed to show this
-        # print(col_width)
-
-        # https://docs.microsoft.com/en-us/dotnet/api/documentformat.openxml.spreadsheet.column
-
-        # TODO save this instead as internal package data for quicker loading
-        fw <- system.file("extdata", "fontwidth/FontWidth.csv", package = "openxlsx2")
-        font_width_tab <- read.csv(fw)
-
-        # TODO base font might not be the font used in this column
-        base_font <- wb_get_base_font(self)
-        font <- base_font$name$val
-        size <- as.integer(base_font$size$val)
-
-        sel <- font_width_tab$FontFamilyName == font & font_width_tab$FontSize == size
-        # maximum digit width of selected font
-        mdw <- font_width_tab$Width[sel]
 
-        # formula from openxml.spreadsheet.column documentation. The formula returns exactly the expected
-        # value, but the output in excel is still off. Therefore round to create even numbers. In my tests
-        # the results were close to the initial col_width sizes. Character width is still bad, numbers are
-        # way larger, therefore characters cells are to wide. Not sure if we need improve this.
-        widths <- trunc((col_width * mdw + 5) / mdw * 256) / 256
-        widths <- round(widths)
-      }
+      # https://docs.microsoft.com/en-us/dotnet/api/documentformat.openxml.spreadsheet.column
+      widths <- calc_col_width(base_font = base_font, col_width = col_width)
 
       # create empty cols
       if (NROW(col_df) == 0)

R/class-worksheet.R

@@ -199,7 +199,7 @@ wbWorksheet <- R6::R6Class(
       self$sheetPr               <- tabColour
       self$dimension             <- '<dimension ref="A1"/>'
       self$sheetViews            <- sprintf('<sheetViews><sheetView workbookViewId="0" zoomScale="%s" showGridLines="%s" showRowColHeaders="%s" tabSelected="%s"/></sheetViews>', as.integer(zoom), as.integer(gridLines), as.integer(rowColHeaders), as.integer(tabSelected))
-      self$sheetFormatPr         <- '<sheetFormatPr defaultRowHeight="15.0"/>'
+      self$sheetFormatPr         <- '<sheetFormatPr baseColWidth="8.43" defaultRowHeight="16" x14ac:dyDescent="0.2"/>'
       self$cols_attr             <- character()
       self$autoFilter            <- character()
       self$mergeCells            <- character()
@@ -714,7 +714,7 @@ empty_cols_attr <- function(n = 0, beg, end) {
   if (n > 0) {
     z$min <- n_seq
     z$max <- n_seq
-    z$width <- "8.43" # default width in ms365
+    z$width <- "8.43"
   }
 
   z

R/converters.R

@@ -61,3 +61,40 @@ get_cell_refs <- function(cellCoords) {
   l <- int2col(unlist(cellCoords[, 2]))
   paste0(l, cellCoords[, 1])
 }
+
+
+
+#' calculate the required column width
+#'
+#' @param base_font the base font name and fontsize
+#' @param col_width column width
+#' @keywords internal
+#' @examples
+#' base_font <- wb_get_base_font(wb)
+#' calc_col_width(base_font, col_width = 10)
+#' @noRd
+calc_col_width <- function(base_font, col_width) {
+
+  # TODO save this instead as internal package data for quicker loading
+  fw <- system.file("extdata", "fontwidth/FontWidth.csv", package = "openxlsx2")
+  font_width_tab <- read.csv(fw)
+
+  # TODO base font might not be the font used in this column
+  font <- base_font$name$val
+  size <- as.integer(base_font$size$val)
+
+  sel <- font_width_tab$FontFamilyName == font & font_width_tab$FontSize == size
+  # maximum digit width of selected font
+  mdw <- font_width_tab$Width[sel]
+
+  # formula from openxml.spreadsheet.column documentation. The formula returns exactly the expected
+  # value, but the output in excel is still off. Therefore round to create even numbers. In my tests
+  # the results were close to the initial col_width sizes. Character width is still bad, numbers are
+  # way larger, therefore characters cells are to wide. Not sure if we need improve this.
+
+  # Note: cannot reproduce the exact values with MS365 on Mac. Nevertheless, these values are closer
+  # to the expected widths
+  widths <- trunc((as.numeric(col_width) * mdw + 5) / mdw * 256) / 256
+  widths <- round(widths, 3)
+  widths
+}

tests/testthat/test-base_font.R

@@ -5,12 +5,12 @@ test_that("get_base_font works", {
     list(
       size = list(val = "11"),
       # should this be "#000000"?
-      colour = list(rgb = "FF000000"),
+      colour = list(theme = "1"),
       name = list(val = "Calibri")
     )
   )
 
-  wb$set_base_font(fontSize = 9, fontName = "Arial", fontColour = "red")
+  wb$set_base_font(fontSize = 9, fontName = "Arial", fontColour = wb_colour("red"))
   expect_equal(
     wb$get_base_font(),
     list(

tests/testthat/test-class-workbook.R

@@ -13,7 +13,7 @@ test_that("wb_set_col_widths", {
   # set column width to 12
   expect_silent(wb$set_col_widths("test", widths = 12L, cols = seq_along(mtcars)))
   expect_equal(
-    "<col min=\"1\" max=\"11\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"12\"/>",
+    "<col min=\"1\" max=\"11\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"12.711\"/>",
     wb$worksheets[[1]]$cols_attr
   )
 
@@ -23,22 +23,46 @@ test_that("wb_set_col_widths", {
   # reset the column with, we do not provide an option ot remove the column entry
   expect_silent(wb$set_col_widths("test", cols = seq_along(mtcars)))
   expect_equal(
-    "<col min=\"1\" max=\"11\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"8.43\"/>",
+    "<col min=\"1\" max=\"11\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"9.141\"/>",
     wb$worksheets[[1]]$cols_attr
   )
 
   # create column width for column 25
   expect_silent(wb$set_col_widths("test", cols = "Y", widths = 22))
   expect_equal(
-    c("<col min=\"1\" max=\"11\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"8.43\"/>",
+    c("<col min=\"1\" max=\"11\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"9.141\"/>",
       "<col min=\"12\" max=\"24\" width=\"8.43\"/>",
-      "<col min=\"25\" max=\"25\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"22\"/>"),
+      "<col min=\"25\" max=\"25\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"22.711\"/>"),
     wb$worksheets[[1]]$cols_attr
   )
 
   # a few more errors
   expect_error(wb$set_col_widths("test", cols = "Y", width = 1:2))
   expect_error(wb$set_col_widths("test", cols = "Y", hidden = 1:2))
+
+
+
+
+  wb <- wb_workbook()$
+    add_worksheet()$
+    set_col_widths(cols = 1:10, width = (8:17) + .5)$
+    add_data(x = rbind(8:17), colNames = FALSE)
+
+  exp <- c(
+    "<col min=\"1\" max=\"1\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"9.211\"/>",
+    "<col min=\"2\" max=\"2\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"10.211\"/>",
+    "<col min=\"3\" max=\"3\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"11.211\"/>",
+    "<col min=\"4\" max=\"4\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"12.211\"/>",
+    "<col min=\"5\" max=\"5\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"13.211\"/>",
+    "<col min=\"6\" max=\"6\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"14.211\"/>",
+    "<col min=\"7\" max=\"7\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"15.211\"/>",
+    "<col min=\"8\" max=\"8\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"16.211\"/>",
+    "<col min=\"9\" max=\"9\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"17.211\"/>",
+    "<col min=\"10\" max=\"10\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"18.211\"/>"
+  )
+  got <- wb$worksheets[[1]]$cols_attr
+  expect_equal(exp, got)
+
 })
 
 

tests/testthat/test-wb_styles.R

@@ -159,17 +159,19 @@ test_that("test add_font()", {
   expect_silent(wb$add_font("S1", dims = "A1:K1", color = wb_colour(hex = "FFFFFF00")))
 
   # check xf
-  exp <- c("<xf numFmtId=\"0\" fontId=\"0\" fillId=\"0\" borderId=\"0\" xfId=\"0\"/>",
-           "<xf applyFont=\"1\" borderId=\"0\" fillId=\"0\" fontId=\"1\" numFmtId=\"0\" xfId=\"0\"/>"
+  exp <- c(
+    "<xf numFmtId=\"0\" fontId=\"0\" fillId=\"0\" borderId=\"0\" xfId=\"0\"/>",
+    "<xf applyFont=\"1\" borderId=\"0\" fillId=\"0\" fontId=\"1\" numFmtId=\"0\" xfId=\"0\"/>"
   )
   got <- wb$styles_mgr$styles$cellXfs
 
   expect_equal(exp, got)
 
 
   # check font
-  exp <- c("<font><sz val=\"11\"/><color rgb=\"FF000000\"/><name val=\"Calibri\"/><family val=\"2\"/><scheme val=\"minor\"/></font>",
-           "<font><color rgb=\"FFFFFF00\"/><name val=\"Calibri\"/><sz val=\"11\"/></font>"
+  exp <- c(
+    "<font><sz val=\"11\"/><color theme=\"1\"/><name val=\"Calibri\"/><family val=\"2\"/><scheme val=\"minor\"/></font>",
+    "<font><color rgb=\"FFFFFF00\"/><name val=\"Calibri\"/><sz val=\"11\"/></font>"
   )
   got <- wb$styles_mgr$styles$fonts
 
@@ -434,7 +436,7 @@ test_that("style names are xml", {
   exp <- list(
     numFmts = NULL,
     fonts = c(
-      "<font><sz val=\"11\"/><color rgb=\"FF000000\"/><name val=\"Calibri\"/><family val=\"2\"/><scheme val=\"minor\"/></font>",
+      "<font><sz val=\"11\"/><color theme=\"1\"/><name val=\"Calibri\"/><family val=\"2\"/><scheme val=\"minor\"/></font>",
       "<font><b val=\"1\"/><color rgb=\"FF000000\"/><name val=\"Calibri\"/><sz val=\"14\"/></font>",
       "<font><b val=\"1\"/><color rgb=\"FF000000\"/><name val=\"Calibri\"/><sz val=\"11\"/></font>",
       "<font><color rgb=\"FF000000\"/><i val=\"1\"/><name val=\"Calibri\"/><sz val=\"11\"/></font>",