[wb_to_df] create type f when reading formula

JanMarvin · Aug 8, 2024 · 4fa4155 · 4fa4155
1 parent 51772b9
commit 4fa4155
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)