* New exclude() helps remove columns and resulting duplicated rows (#772)

Author: maurolepore

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(exclude,data.frame)
+S3method(exclude,tilt_profile)
 S3method(join_to,data.frame)
 S3method(join_to,tilt_profile)
 S3method(rowid,default)
@@ -23,6 +25,7 @@ export(example_dictionary)
 export(example_raw_companies)
 export(example_raw_ipr)
 export(example_raw_weo)
+export(exclude)
 export(extdata_path)
 export(is_tilt_profile)
 export(istr)

R/exclude.R

@@ -0,0 +1,62 @@
+#' Exclude columns matching a pattern and the resulting duplicates
+#'
+#' @param data A dataframe.
+#' @inheritParams tidyselect::matches
+#'
+#' @return A dataframe excluding the matching columns and duplicates.
+#' @export
+#' @family helpers
+#'
+#' @examples
+#' library(tibble)
+#'
+#' # Excludes columns along with all its duplicates
+#' data <- tibble(x = 1, y = 1:2)
+#' data
+#' data |> exclude("y")
+#'
+#' # Columns are matched as a regular expression
+#' data <- tibble(x = 1, yz = 1:2, zy = 1)
+#' data
+#' data |> exclude("y")
+#' data |> exclude("y$")
+#'
+#'
+#'
+#' # With a 'tilt_profile' excludes at both levels in a single step
+#'
+#' product <- company <- tibble(companies_id = 1, y = "a", z = 1)
+#' result <- tilt_profile(nest_levels(product, company))
+#' result |> class()
+#' result
+#'
+#' out <- result |> exclude("y")
+#' out |> unnest_product()
+#' out |> unnest_company()
+exclude <- function(data, match) {
+  UseMethod("exclude")
+}
+
+#' @export
+exclude.data.frame <- function(data, match) {
+  out <- select(data, -matches(match))
+
+  no_match <- rlang::is_empty(names_diff(data, out))
+  if (no_match) {
+    return(out)
+  } else {
+    distinct(out)
+  }
+}
+
+#' @export
+exclude.tilt_profile <- function(data, match) {
+  product <- exclude(unnest_product(data), match)
+  company <- exclude(unnest_company(data), match)
+  result <- nest_levels(product, company)
+  tilt_profile(result)
+}
+
+names_diff <- function(x, y) {
+  setdiff(names(x), names(y))
+}

man/exclude.Rd

@@ -0,0 +1,38 @@
+test_that("if matches a column, excludes the column and duplicated rows", {
+  data <- tibble(x = c(1, 1), y = x)
+
+  out <- exclude(data, "y")
+
+  expect_false(hasName(out, "y"))
+  expect_true(nrow(out) < nrow(data))
+})
+
+test_that("if doesn't match any column, yields the inpt data", {
+  data <- tibble(x = c(1, 1), y = x)
+
+  out <- exclude(data, "unmatched")
+
+  expect_equal(out, data)
+})
+
+test_that("with a tilt_profile yields a tilt_profile", {
+  product <- company <- tibble(companies_id = c(1, 1), y = companies_id)
+  result <- tilt_profile(nest_levels(product, company))
+
+  out <- exclude(result, "y")
+
+  expect_s3_class(out, "tilt_profile")
+})
+
+test_that("with a tilt_profile excludes at both levels", {
+  product <- company <- tibble(companies_id = c(1, 1), y = companies_id)
+  result <- tilt_profile(nest_levels(product, company))
+
+  out <- exclude(result, "y")
+
+  expect_false(hasName(unnest_product(out), "y"))
+  expect_false(hasName(unnest_company(out), "y"))
+
+  expect_true(nrow(unnest_product(out)) < nrow(product))
+  expect_true(nrow(unnest_company(out)) < nrow(company))
+})