[wb_to_df] create type f when reading formula (#1103)

JanMarvin · Aug 8, 2024 · e3c5c4c · e3c5c4c
1 parent 51772b9
commit e3c5c4c
Show file tree

Hide file tree

Showing 4 changed files with 23 additions and 7 deletions.
diff --git a/R/read.R b/R/read.R
@@ -461,7 +461,7 @@ wb_to_df <- function(
 
  sel <- cc$f != ""
  cc$val[sel] <- replaceXMLEntities(cc$f[sel])
- cc$typ[sel] <- "s"
+ cc$typ[sel] <- "f"
 
  }
 
@@ -621,13 +621,19 @@ wb_to_df <- function(
  poxs <- names(which(types[sel] == 3))
  logs <- names(which(types[sel] == 4))
  difs <- names(which(types[sel] == 5))
+ fmls <- names(which(types[sel] == 6))
  # convert "#NUM!" to "NaN" -- then converts to NaN
  # maybe consider this an option to instead return NA?
  if (length(nums)) z[nums] <- lapply(z[nums], function(i) as.numeric(replace(i, i == "#NUM!", "NaN")))
  if (length(dtes)) z[dtes] <- lapply(z[dtes], date_conv, origin = origin)
  if (length(poxs)) z[poxs] <- lapply(z[poxs], datetime_conv, origin = origin)
  if (length(logs)) z[logs] <- lapply(z[logs], as.logical)
  if (isNamespaceLoaded("hms")) z[difs] <- lapply(z[difs], hms_conv)
+
+ for (i in seq_along(z)) { # convert df to class formula
+ if (names(z)[i] %in% fmls) class(z[[i]]) <- c(class(z[[i]]), "formula")
+ }
+
  } else {
  warning("could not convert. All missing in row used for variable names")
  }

diff --git a/R/wb_functions.R b/R/wb_functions.R
@@ -180,6 +180,10 @@ guess_col_type <- function(tt) {
  col_dte <- vapply(tt[!col_num], function(x) all(x == "h", na.rm = TRUE), NA)
  types[names(col_dte[col_dte])] <- 5
 
+ # or formula
+ col_fml <- vapply(tt[!col_num], function(x) all(x == "f", na.rm = TRUE), NA)
+ types[names(col_fml[col_fml])] <- 6
+
  types
 }
 

diff --git a/tests/testthat/test-cloneWorksheet.R b/tests/testthat/test-cloneWorksheet.R
@@ -93,7 +93,10 @@ test_that("copy cells", {
  got <- wb_data(wb, sheet = 3, dims = "A20:D23", col_names = FALSE)
  expect_equal(unlist(t(dat)), unlist(got), ignore_attr = TRUE)
 
- exp <- c("'Sheet 1'!A1", "'Sheet 1'!B1", "'Sheet 1'!C1", "'Sheet 1'!D1")
+ exp <- structure(
+ c("'Sheet 1'!A1", "'Sheet 1'!B1", "'Sheet 1'!C1", "'Sheet 1'!D1"),
+ class = c("character", "formula")
+ )
  got <- wb_data(wb, sheet = 4, dims = "A20:D23", col_names = FALSE, show_formula = TRUE)[[1]]
  expect_equal(exp, got)
 

diff --git a/tests/testthat/test-read_xlsb.R b/tests/testthat/test-read_xlsb.R
@@ -102,10 +102,10 @@ test_that("worksheets with real world formulas", {
  exp <- structure(
  list(
  A = c("1", "A1+1", NA, "SUM({\"1\",\"2\",\"3\"})", "SUMIFS(A1:A2,'[1]foo'!B2:B3,{\"A\"})"),
- B = c("A1+1", "B1+1", NA, "{\"a\"}", NA),
- C = c("B1+1", "C1+1", NA, NA, NA),
- D = c("C1+1", "D1+1", NA, NA, NA),
- E = c("D1+1", "E1+1", NA, NA, NA)
+ B = structure(c("A1+1", "B1+1", NA, "{\"a\"}", NA), class = c("character", "formula")),
+ C = structure(c("B1+1", "C1+1", NA, NA, NA), class = c("character", "formula")),
+ D = structure(c("C1+1", "D1+1", NA, NA, NA), class = c("character", "formula")),
+ E = structure(c("D1+1", "E1+1", NA, NA, NA), class = c("character", "formula"))
  ),
  row.names = c(NA, 5L),
  class = "data.frame"
@@ -118,7 +118,10 @@ test_that("worksheets with real world formulas", {
 
  wb <- wb_load(xlsxFile)
 
- exp <- "IF(ISNA(MATCH(G681,{\"Annual\",\"\"\"5\"\"\",\"\"\"1+4\"\"\"},0)),1,MATCH(G681,{\"Annual\",\"\"\"5\"\"\",\"\"\"1+4\"\"\"},0))"
+ exp <- structure(
+ "IF(ISNA(MATCH(G681,{\"Annual\",\"\"\"5\"\"\",\"\"\"1+4\"\"\"},0)),1,MATCH(G681,{\"Annual\",\"\"\"5\"\"\",\"\"\"1+4\"\"\"},0))",
+ class = c("character", "formula")
+ )
  got <- wb_to_df(wb, col_names = FALSE, show_formula = TRUE)$A
  expect_equal(exp, got)