[misc] revive support for R versions < 4.0

Many `stringsAsFactors = FALSE` changes
JanMarvin · Dec 17, 2024 · df5abcb · df5abcb
1 parent 964d911
commit df5abcb
Show file tree

Hide file tree

Showing 31 changed files with 156 additions and 94 deletions.
diff --git a/R/class-style_mgr.R b/R/class-style_mgr.R
@@ -8,8 +8,8 @@
 #' # style <- style_mgr$new(wb)
 #' # style$initialize(wb)
 #'
-#' # wb$styles_mgr$get_numfmt() |> print()
-#' # wb$styles_mgr$next_numfmt_id() |> print()
+#' # wb$styles_mgr$get_numfmt() %>% print()
+#' # wb$styles_mgr$next_numfmt_id() %>% print()
 #' # wb$styles_mgr$get_numfmt_id("numFmt-166")
 #'
 #' # create new number format
@@ -129,7 +129,8 @@ style_mgr <- R6::R6Class("wbStylesMgr", {
         self$numfmt <- data.frame(
           typ,
           id,
-          name
+          name,
+          stringsAsFactors = FALSE
         )
       }
 
@@ -142,7 +143,8 @@ style_mgr <- R6::R6Class("wbStylesMgr", {
         self$font <- data.frame(
           typ,
           id,
-          name
+          name,
+          stringsAsFactors = FALSE
         )
       }
 
@@ -155,7 +157,8 @@ style_mgr <- R6::R6Class("wbStylesMgr", {
         self$fill <- data.frame(
           typ,
           id,
-          name
+          name,
+          stringsAsFactors = FALSE
         )
       }
 
@@ -168,7 +171,8 @@ style_mgr <- R6::R6Class("wbStylesMgr", {
         self$border <- data.frame(
           typ,
           id,
-          name
+          name,
+          stringsAsFactors = FALSE
         )
       }
 
@@ -181,7 +185,8 @@ style_mgr <- R6::R6Class("wbStylesMgr", {
         self$xf <- data.frame(
           typ,
           id,
-          name
+          name,
+          stringsAsFactors = FALSE
         )
       }
 
@@ -195,7 +200,8 @@ style_mgr <- R6::R6Class("wbStylesMgr", {
         self$cellStyle <- data.frame(
           typ,
           id,
-          name
+          name,
+          stringsAsFactors = FALSE
         )
       }
 
@@ -209,7 +215,8 @@ style_mgr <- R6::R6Class("wbStylesMgr", {
         self$cellStyleXf <- data.frame(
           typ,
           id,
-          name
+          name,
+          stringsAsFactors = FALSE
         )
       }
 
@@ -222,7 +229,8 @@ style_mgr <- R6::R6Class("wbStylesMgr", {
         self$dxf <- data.frame(
           typ,
           id,
-          name
+          name,
+          stringsAsFactors = FALSE
         )
       }
 
@@ -249,7 +257,8 @@ style_mgr <- R6::R6Class("wbStylesMgr", {
           self$tableStyle <- data.frame(
             typ,
             id,
-            name
+            name,
+            stringsAsFactors = FALSE
           )
         }
       }
@@ -533,7 +542,8 @@ style_mgr <- R6::R6Class("wbStylesMgr", {
         new_entry <- data.frame(
           typ = typ,
           id = id[length(id)],
-          name = style_name[sty]
+          name = style_name[sty],
+          stringsAsFactors = FALSE
         )
 
         if (is_numfmt) self$numfmt      <- rbind(self$numfmt, new_entry)

diff --git a/R/class-workbook-wrappers.R b/R/class-workbook-wrappers.R
@@ -290,7 +290,8 @@ wb_add_data <- function(
 #'   add_data_table(
 #'     x = as.data.frame(USPersonalExpenditure),
 #'     row_names = TRUE,
-#'     total_row = c(text = "Total", "none", "sum", "sum", "sum", "SUM")
+#'     total_row = c(text = "Total", "none", "sum", "sum", "sum", "SUM"),
+#'     stringsAsFactors = FALSE
 #'   )
 #' @export
 wb_add_data_table <- function(
@@ -528,7 +529,8 @@ wb_add_pivot_table <- function(
 #' df <- data.frame(
 #'   AirPassengers = c(AirPassengers),
 #'   time = seq(from = as.Date("1949-01-01"), to = as.Date("1960-12-01"), by = "month"),
-#'   letters = letters[1:4]
+#'   letters = letters[1:4],
+#'   stringsAsFactors = FALSE
 #' )
 #'
 #' # create workbook

diff --git a/R/class-workbook.R b/R/class-workbook.R
@@ -2586,14 +2586,14 @@ wbWorkbook <- R6::R6Class(
 
       if (!is.null(target) && is.null(names(target))) {
         if (nrow(x) > ncol(x)) {
-          target <- as.data.frame(as.matrix(target, nrow = nrow(x), ncol = ncol(x)))
+          target <- as.data.frame(as.matrix(target, nrow = nrow(x), ncol = ncol(x)), stringsAsFactors = FALSE)
         }
         names(target) <- nams
       }
 
       if (!is.null(tooltip) && is.null(names(tooltip))) {
         if (nrow(x) > ncol(x)) {
-          tooltip <- as.data.frame(as.matrix(tooltip, nrow = nrow(x), ncol = ncol(x)))
+          tooltip <- as.data.frame(as.matrix(tooltip, nrow = nrow(x), ncol = ncol(x)), stringsAsFactors = FALSE)
         }
         names(tooltip) <- nams
       }
@@ -4000,7 +4000,7 @@ wbWorkbook <- R6::R6Class(
       if (transpose) {
         to_cols <- seq.int(start_col, start_col + to_nrow)
         to_rows <- seq.int(start_row, start_row + to_ncol)
-        from_dims_df <- as.data.frame(t(from_dims_df))
+        from_dims_df <- as.data.frame(t(from_dims_df), stringsAsFactors = FALSE)
       }
 
       to_dims       <- rowcol_to_dims(to_rows, to_cols)
@@ -4015,7 +4015,7 @@ wbWorkbook <- R6::R6Class(
 
       # TODO improve this. It should use v or inlineStr from cc
       if (as_value) {
-        data <- as.data.frame(unclass(data))
+        data <- as.data.frame(unclass(data), stringsAsFactors = FALSE)
 
         if (transpose) {
           data <- t(data)
@@ -4031,10 +4031,12 @@ wbWorkbook <- R6::R6Class(
 
       to_cc <- cc[match(from_dims, cc$r), ]
       from_cells <- to_cc$r
-      to_cc[c("r", "row_r", "c_r")] <- cbind(
-        to_dims_f,
-        gsub("\\D+", "", to_dims_f),
-        int2col(col2int(to_dims_f))
+
+      to_cc[c("r", "row_r", "c_r")] <- data.frame(
+        r     = to_dims_f,
+        row_r = gsub("\\D+", "", to_dims_f),
+        c_r   = int2col(col2int(to_dims_f)),
+        stringsAsFactors = FALSE
       )
 
       if (as_ref) {
@@ -5433,7 +5435,7 @@ wbWorkbook <- R6::R6Class(
           sprintf(
             '<pane %s topLeftCell="%s" activePane="%s" state="frozen"/><selection pane="%s"/>',
             stringi::stri_join(attrs, collapse = " ", sep = " "),
-            get_cell_refs(data.frame(first_active_row, first_active_col)),
+            get_cell_refs(data.frame(first_active_row, first_active_col, stringsAsFactors = FALSE)),
             activePane,
             activePane
           )
@@ -5502,7 +5504,7 @@ wbWorkbook <- R6::R6Class(
 
       cmts <- list()
       if (length(cmmt) && length(self$comments) <= cmmt) {
-        cmts <- as.data.frame(do.call("rbind", self$comments[[cmmt]]))
+        cmts <- as.data.frame(do.call("rbind", self$comments[[cmmt]]), stringsAsFactors = FALSE)
         if (!is.null(dims)) cmts <- cmts[cmts$ref %in% dims, ]
         # print(cmts)
         cmts <- cmts[c("ref", "author", "comment")]
@@ -5666,7 +5668,8 @@ wbWorkbook <- R6::R6Class(
 
         tc <- cbind(
           rbindlist(xml_attr(self$threadComments[[thread_id]], "threadedComment")),
-          text = xml_value(self$threadComments[[thread_id]], "threadedComment", "text")
+          text = xml_value(self$threadComments[[thread_id]], "threadedComment", "text"),
+          stringsAsFactors = FALSE
         )
 
         # probably correclty ordered, but we could order these by date?
@@ -5703,7 +5706,8 @@ wbWorkbook <- R6::R6Class(
 
       tc <- cbind(
         rbindlist(xml_attr(self$threadComments[[thrd]], "threadedComment")),
-        text = xml_value(self$threadComments[[thrd]], "threadedComment", "text")
+        text = xml_value(self$threadComments[[thrd]], "threadedComment", "text"),
+        stringsAsFactors = FALSE
       )
 
       if (!is.null(dims) && any(grepl(":", dims)))
@@ -5828,7 +5832,7 @@ wbWorkbook <- R6::R6Class(
           if (!grepl("[A-Z]", substr(rule, 1, 2))) {
             ## formula looks like "operatorX" , attach top left cell to rule
             rule <- paste0(
-              get_cell_refs(data.frame(min(rows), min(cols))),
+              get_cell_refs(data.frame(min(rows), min(cols), stringsAsFactors = FALSE)),
               rule
             )
           } ## else, there is a letter in the formula and apply as is
@@ -6550,7 +6554,8 @@ wbWorkbook <- R6::R6Class(
         style   = styleplot_xml,
         rels    = chart1_rels_xml(next_chart),
         chartEx = "",
-        relsEx  = ""
+        relsEx  = "",
+        stringsAsFactors = FALSE
       )
 
       self$charts <- rbind(self$charts, chart)
@@ -7804,7 +7809,7 @@ wbWorkbook <- R6::R6Class(
 
       self$worksheets[[sheet]]$autoFilter <- sprintf(
         '<autoFilter ref="%s"/>',
-        paste(get_cell_refs(data.frame("x" = c(rows, rows), "y" = c(min(cols), max(cols)))), collapse = ":")
+        paste(get_cell_refs(data.frame("x" = c(rows, rows), "y" = c(min(cols), max(cols)), stringsAsFactors = FALSE)), collapse = ":")
       )
 
       invisible(self)
@@ -9940,7 +9945,7 @@ wbWorkbook <- R6::R6Class(
       # TODO can this be moved to the sheet data?
       sheet <- private$get_sheet_index(sheet)
       sqref <- stringi::stri_join(
-        get_cell_refs(data.frame(x = c(startRow, endRow), y = c(startCol, endCol))),
+        get_cell_refs(data.frame(x = c(startRow, endRow), y = c(startCol, endCol), stringsAsFactors = FALSE)),
         collapse = ":"
       )
 

diff --git a/R/class-worksheet.R b/R/class-worksheet.R
@@ -488,7 +488,9 @@ wbWorksheet <- R6::R6Class(
         data.frame(
           string = values,
           min = cumsum(lengths) - lengths + 1,
-          max = cumsum(lengths))
+          max = cumsum(lengths),
+          stringsAsFactors = FALSE
+        )
       )
 
       # remove duplicates pre merge

diff --git a/R/get-named-regions.R b/R/get-named-regions.R
@@ -8,7 +8,8 @@ get_nr_from_definedName <- function(wb) {
 
   dn <- cbind(
     rbindlist(xml_attr(dn, "definedName")),
-    value =  xml_value(dn, "definedName")
+    value =  xml_value(dn, "definedName"),
+    stringsAsFactors = FALSE
   )
 
   if (!is.null(dn$value)) {

diff --git a/R/helper-functions.R b/R/helper-functions.R
@@ -390,7 +390,7 @@ split_dims <- function(dims, direction = "row") {
     if (direction == 2) direction <- "col"
   }
   direction <- match.arg(direction, choices = c("row", "col"))
-  if (direction == "row") df <- as.data.frame(t(df))
+  if (direction == "row") df <- as.data.frame(t(df), stringsAsFactors = FALSE)
   vapply(df, FUN = function(x) {
     fst <- x[1]
     snd <- x[length(x)]
@@ -1165,7 +1165,7 @@ known_subtotal_funs <- function(x, total, table, row_names = FALSE) {
   }
 
   # prepare output
-  fml <- as.data.frame(t(fml))
+  fml <- as.data.frame(t(fml), stringsAsFactors = FALSE)
   names(fml) <- nms_x
   names(atr) <- nms_x
   names(lbl) <- nms_x
@@ -1298,7 +1298,7 @@ fits_in_dims <- function(x, dims, startCol, startRow) {
 transpose_df <- function(x) {
   attribs <- attr(x, "c_cm")
   classes <- class(x[[1]])
-  x <- as.data.frame(t(x))
+  x <- as.data.frame(t(x), stringsAsFactors = FALSE)
   for (i in seq_along(x)) {
     class(x[[i]]) <- classes
   }

diff --git a/R/pivot_table.R b/R/pivot_table.R
@@ -228,7 +228,7 @@ get_items <- function(data, x, item_order, slicer = FALSE, choose = NULL, has_de
 
   if (!is.null(choose)) {
     # change order
-    choose <- eval(parse(text = choose), data.frame(x = dat))[item_order]
+    choose <- eval(parse(text = choose), data.frame(x = dat, stringsAsFactors = FALSE))[item_order]
     hide <- as_xml_attr(!choose)
     sele <- as_xml_attr(choose)
   } else {

diff --git a/R/read.R b/R/read.R
@@ -462,7 +462,8 @@ wb_to_df <- function(
                 lapply(hls, function(hl) {
                   c(hl$ref, ifelse(is.null(hl$target), hl$location, hl$target))
                 })
-        )
+        ),
+        stringsAsFactors = FALSE
       )
       cc$val[match(hyprlnks$V1, cc$r)] <- hyprlnks$V2
     }

diff --git a/R/utils.R b/R/utils.R
@@ -275,7 +275,7 @@ con_rng <- function(x) {
   ranges <- tapply(x, group, function(y) c(beg = y[1], end = y[length(y)]))
   ranges_df <- do.call(rbind, ranges)
 
-  as.data.frame(ranges_df)
+  as.data.frame(ranges_df, stringsAsFactors = FALSE)
 }
 
 #' create consecutive dims from column and row vector
@@ -841,7 +841,7 @@ wb_dims <- function(..., select = NULL) {
   x_has_named_dims <- inherits(x, "data.frame") || inherits(x, "matrix")
 
   if (!is.null(x)) {
-    x <- as.data.frame(x)
+    x <- as.data.frame(x, stringsAsFactors = FALSE)
   }
 
   cnam      <- isTRUE(args$col_names)
@@ -1363,3 +1363,9 @@ ave2 <- function(x, y, FUN) {
   split(x, g) <- lapply(split(x, g), FUN)
   x
 }
+
+if (getRversion() < "4.0.0") {
+  deparse1 <- function(expr, collapse = " ") {
+    paste(deparse(expr), collapse = collapse)
+  }
+}
diff --git a/R/wb_load.R b/R/wb_load.R
@@ -749,7 +749,8 @@ wb_load <- function(
       colors  = empty_chr,
       style   = empty_chr,
       rels    = empty_chr,
-      relsEx  = empty_chr
+      relsEx  = empty_chr,
+      stringsAsFactors = FALSE
     )
 
     chartsXML_id        <- filename_id(chartsXML)

diff --git a/R/wb_styles.R b/R/wb_styles.R
@@ -1286,6 +1286,7 @@ create_colors_xml <- function(
     ), pointer = FALSE
   )
 }
+
 #' @export
 #' @rdname create_colors_xml
 #' @usage NULL