From 4fa41552c51840265f1bc2f2090ea19362f339eb Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Thu, 8 Aug 2024 09:49:54 +0200 Subject: [PATCH] [wb_to_df] create type `f` when reading formula --- R/read.R | 8 +++++++- R/wb_functions.R | 4 ++++ tests/testthat/test-cloneWorksheet.R | 5 ++++- tests/testthat/test-read_xlsb.R | 13 ++++++++----- 4 files changed, 23 insertions(+), 7 deletions(-) diff --git a/R/read.R b/R/read.R index 73679ffa6..8fee1f3b3 100644 --- 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,6 +621,7 @@ 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"))) @@ -628,6 +629,11 @@ wb_to_df <- function( 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 index 829a9020c..aa52ad427 100644 --- 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 index 1afde426e..0e4496300 100644 --- 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 index b25cc94a0..67d48bd41 100644 --- 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)