Merge pull request #2221 from UchidaMizuki/fix-rename_with-etc-#2220

Fix `rename_with()` and `pivot_wider()` to work for unquoted arguments

R/tidyverse.R

@@ -248,10 +248,29 @@ rename_with.sf = function(.data, .fn, .cols, ...) {
 
 	agr = st_agr(.data)
 
-	ret = NextMethod()
+	.data = as.data.frame(.data)
+	ret = if (missing(.cols)) {
+		if (!requireNamespace("tidyselect", quietly = TRUE)) {
+			stop("tidyselect required: install that first") # nocov
+		}
+		dplyr::rename_with(
+			.data = .data,
+			.fn = .fn,
+			.cols = tidyselect::everything(), 
+			...
+		)
+	} else {
+		dplyr::rename_with(
+			.data = .data,
+			.fn = .fn,
+			.cols = {{ .cols }}, 
+			...
+		)
+	}
+	ret = st_as_sf(ret, sf_column_name = names(ret)[sf_column_loc])
+
 	names(agr) = .fn(names(agr))
 	st_agr(ret) = agr
-	st_geometry(ret) = names(ret)[sf_column_loc]
 	ret
 }
 
@@ -445,32 +464,60 @@ pivot_longer.sf <- function (data, cols, names_to = "name", names_prefix = NULL,
 #' @name tidyverse
 #' @export
 #' @param id_cols see original function docs
+#' @param id_expand see original function docs
 #' @param names_from see original function docs
 #' @param names_prefix see original function docs
 #' @param names_sep see original function docs
 #' @param names_glue see original function docs
 #' @param names_sort see original function docs
+#' @param names_vary see original function docs
+#' @param names_expand see original function docs
 #' @param names_repair see original function docs
 #' @param values_from see original function docs
 #' @param values_fill see original function docs
 #' @param values_fn see original function docs
-pivot_wider.sf = function(data,
-                          id_cols = NULL,
-                          names_from, # = name,
-                          names_prefix = "",
-                          names_sep = "_",
-                          names_glue = NULL,
-                          names_sort = FALSE,
-                          names_repair = "check_unique",
-                          values_from, # = value,
-                          values_fill = NULL,
-                          values_fn = NULL,
-                          ...) {
+#' @param unused_fn see original function docs
+pivot_wider.sf = function(data, 
+						  ..., 
+						  id_cols = NULL, 
+						  id_expand = FALSE, 
+						  names_from = name, 
+						  names_prefix = "", 
+						  names_sep = "_", 
+						  names_glue = NULL, 
+						  names_sort = FALSE, 
+						  names_vary = "fastest", 
+						  names_expand = FALSE, 
+						  names_repair = "check_unique", 
+						  values_from = value, 
+						  values_fill = NULL, 
+						  values_fn = NULL, 
+						  unused_fn = NULL) {
 
 	agr = st_agr(data)
 	sf_column_name = attr(data, "sf_column")
-	class(data) = setdiff(class(data), "sf")
-	.re_sf(NextMethod(), sf_column_name = sf_column_name, agr)
+	data = as.data.frame(data)
+	if (!requireNamespace("tidyr", quietly = TRUE))
+		stop("tidyr required: install first?")
+	ret = tidyr::pivot_wider(
+		data = data, 
+		..., 
+		id_cols = {{ id_cols }}, 
+		id_expand = id_expand, 
+		names_from = {{ names_from }}, 
+		names_prefix = names_prefix, 
+		names_sep = names_sep, 
+		names_glue = names_glue, 
+		names_sort = names_sort, 
+		names_vary = names_vary, 
+		names_expand = names_expand, 
+		names_repair = names_repair, 
+		values_from = {{ values_from }}, 
+		values_fill = values_fill, 
+		values_fn = values_fn, 
+		unused_fn = unused_fn
+	)
+	st_as_sf(ret, sf_column_name = sf_column_name, agr = agr)
 }
 
 

tests/testthat/test_tidy.R

@@ -266,6 +266,16 @@ test_that("`rename_with()` correctly changes the sf_column attribute (#2215)", {
 	expect_equal(nc %>% rename_with(fn, "geometry") %>% attr("sf_column"), fn(sf_column))
 })
 
+test_that("`rename_with()` works for unquoted `.cols` (#2220)", {
+	skip_if_not_installed("dplyr")
+
+	sf_column = attr(nc, "sf_column")
+	fn = function(x) paste0(x, "_renamed")
+
+	expect_identical(nc %>% rename_with(fn, c(FIPS, FIPSNO)), 
+					 nc %>% rename_with(fn, c("FIPS", "FIPSNO")))
+})
+
 test_that("`select()` and `transmute()` observe back-stickiness of geometry column (#1425)", {
 	skip_if_not_installed("dplyr")
 	sf = read_sf(system.file("shape/nc.shp", package = "sf"))
@@ -308,3 +318,33 @@ test_that("group_split.sf()` does not ignore `.keep` for grouped_df class", {
 	expect_identical(names(nc_kept[[1]]), names(nc))
 	expect_identical(names(nc_notkept[[1]]), setdiff(names(nc), "CNTY_ID"))
 })
+
+test_that("`pivot_wider()` works", {
+	skip_if_not_installed("dplyr")
+	skip_if_not_installed("tidyr")
+
+	# Work for unquoted arguments (#2220)
+	expect_identical(nc %>%
+					 	tidyr::pivot_wider(names_from = NAME,
+					 					   values_from = AREA),
+					 nc %>%
+					 	tidyr::pivot_wider(names_from = "NAME",
+					 					   values_from = "AREA"))
+
+	# Pivot data from long sf to wide sf
+	nc2 = nc %>%
+		mutate(name1 = "value_1",
+			   name2 = "value_2",
+			   name3 = "value_3") %>%
+		as_tibble() %>%
+		st_as_sf() 
+	nc2_longer = nc2 %>%
+		tidyr::pivot_longer(c(name1, name2, name3),
+							names_to = "foo",
+							values_to = "bar")
+	nc2_wider = nc2_longer %>%
+		tidyr::pivot_wider(names_from = foo,
+						   values_from = bar)
+	expect_identical(st_geometry(nc2), st_geometry(nc2_wider))
+	expect_identical(st_drop_geometry(nc2), st_drop_geometry(nc2_wider))
+})