Swapping in base R rows update instead of dplyr::rows_update() (#2115)

* swapping in base R rows_update instead of dplyr::rows_update

* bump veresion

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: gtsummary
 Title: Presentation-Ready Data Summary and Analytic Result Tables
-Version: 2.0.4.9004
+Version: 2.0.4.9005
 Authors@R: c(
     person("Daniel D.", "Sjoberg", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-0862-2018")),

NEWS.md

@@ -12,6 +12,8 @@
 
 * The `modify_caption(caption)` argument now accepts a vector of captions, instead of just a string. Note, however, that not all print engines support a vector of captions. (#2107)
 
+* Swapped out `dplyr::rows_update()` with a base R implementation in `tbl_merge()` that allows for tables with mixed types in `x$table_styling$header$modify_*` columns. For example, `tbl_summary()` has integer Ns and `tbl_svysummary()` has double Ns that can now be combined. (#1626)
+
 # gtsummary 2.0.4
 
 ### New Features and Functions

R/utils-gtsummary_core.R

@@ -153,7 +153,7 @@
 
   x %>%
     # updating rows in header
-    dplyr::rows_update(
+    .rows_update_base(
       y %>% dplyr::select(all_of(common_columns)),
       by = "column"
     ) %>%
@@ -163,3 +163,24 @@
       by = "column"
     )
 }
+
+# a base R version of `dplyr::update_rows()` that allows for combining mixed-type columns
+.rows_update_base <- function(x, y, by) {
+  # convert to data frame so the `[` tibble methods are not used
+  x <- as.data.frame(x)
+  y <- as.data.frame(y)
+
+  # Create a combined key for x and y
+  key_x <- paste(x[, by])
+  key_y <- paste(y[, by])
+
+  # Find matching indices
+  indices <- match(key_y, key_x)
+
+  # Update values for matching rows
+  for (col in setdiff(names(y), by)) {
+    x[indices[!is.na(indices)], col] <- y[!is.na(indices), col]
+  }
+
+  return(dplyr::as_tibble(x))
+}

gtsummary.Rproj

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: 7493750a-124d-41c8-b5ce-f6bfde9a233a
 
 RestoreWorkspace: No
 SaveWorkspace: No

tests/testthat/test-tbl_merge.R

@@ -210,3 +210,32 @@ test_that("tbl_merge throws expected errors", {
     error = TRUE
   )
 })
+
+test_that("tbl_merge() merges mixed-type from .$table_styling$header$modify_* columns", {
+  skip_if_not(is_pkg_installed(c("survey", "cardx", "broom", "withr")))
+  withr::local_seed(123)
+
+  num_rows <- 10
+  toy_data <-
+    data.frame(
+      item1 = sample(c("Never", "Sometimes", "All the time"), num_rows, replace = TRUE),
+      gender = sample(c("Male", "Female"), num_rows, replace = TRUE),
+      weight = rnorm(num_rows, mean = 0, sd = 5) |> abs()
+    )
+  # Create a survey object
+  toy_dataw <- survey::svydesign(data = toy_data, weights = ~weight, ids = ~1)
+  t1 <- tbl_summary(toy_data, by = gender)
+  t2 <- tbl_svysummary(toy_dataw, by = gender)
+  t3 <- tbl_summary(toy_data, include = item1)
+  t4 <- tbl_svysummary(toy_dataw, include = item1)
+
+  # confirm these columns are a mix of integers and non-integers
+  expect_true(t1$table_styling$header$modify_stat_N |> is("integer"))
+  expect_true(t3$table_styling$header$modify_stat_N |> is("integer"))
+  expect_false(t2$table_styling$header$modify_stat_N |> is("integer"))
+  expect_false(t4$table_styling$header$modify_stat_N |> is("integer"))
+
+  # no errors when mixing these variables during the merge
+  expect_silent(tbl_merge(tbls = list(t1, t2)))
+  expect_silent(tbl_merge(tbls = list(t3, t4)))
+})