Skip to content

Commit

Permalink
avoid partial matching (closes #26)
Browse files Browse the repository at this point in the history
  • Loading branch information
@elbersb
elbersb committed Jun 14, 2019
1 parent f8a8a3f commit 6fa742e
Show file tree
Hide file tree
Showing 7 changed files with 82 additions and 75 deletions.
28 changes: 14 additions & 14 deletions R/filter.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,60 +13,60 @@
#' @import dplyr
#' @export
filter <- function(.data, ...) {
log_filter(.data, dplyr::filter, "filter", ...)
log_filter(.data, .fun = dplyr::filter, .funname = "filter", ...)
}

#' @rdname filter
#' @export
filter_all <- function(.data, ...) {
log_filter(.data, dplyr::filter_all, "filter_all", ...)
log_filter(.data, .fun = dplyr::filter_all, .funname = "filter_all", ...)
}

#' @rdname filter
#' @export
filter_if <- function(.data, ...) {
log_filter(.data, dplyr::filter_if, "filter_if", ...)
log_filter(.data, .fun = dplyr::filter_if, .funname = "filter_if", ...)
}

#' @rdname filter
#' @export
filter_at <- function(.data, ...) {
log_filter(.data, dplyr::filter_at, "filter_at", ...)
log_filter(.data, .fun = dplyr::filter_at, .funname = "filter_at", ...)
}

#' @rdname filter
#' @export
distinct <- function(.data, ...) {
log_filter(.data, dplyr::distinct, "distinct", ...)
log_filter(.data, .fun = dplyr::distinct, .funname = "distinct", ...)
}

#' @rdname filter
#' @export
distinct_all <- function(.data, ...) {
log_filter(.data, dplyr::distinct_all, "distinct_all", ...)
log_filter(.data, .fun = dplyr::distinct_all, .funname = "distinct_all", ...)
}

#' @rdname filter
#' @export
distinct_if <- function(.data, ...) {
log_filter(.data, dplyr::distinct_if, "distinct_if", ...)
log_filter(.data, .fun = dplyr::distinct_if, .funname = "distinct_if", ...)
}

#' @rdname filter
#' @export
distinct_at <- function(.data, ...) {
log_filter(.data, dplyr::distinct_at, "distinct_at", ...)
log_filter(.data, .fun = dplyr::distinct_at, .funname = "distinct_at", ...)
}

#' @rdname filter
#' @export
top_n <- function(.data, ...) {
log_filter(.data, dplyr::top_n, "top_n", ...)
log_filter(.data, .fun = dplyr::top_n, .funname = "top_n", ...)
}


log_filter <- function(.data, fun, funname, ...) {
newdata <- fun(.data, ...)
log_filter <- function(.data, .fun, .funname, ...) {
newdata <- .fun(.data, ...)
if (!"data.frame" %in% class(.data) | !should_display()) {
return(newdata)
}
Expand All @@ -75,12 +75,12 @@ log_filter <- function(.data, fun, funname, ...) {

n <- nrow(.data) - nrow(newdata)
if (n == 0) {
display(glue::glue("{funname}{group_status}: no rows removed"))
display(glue::glue("{.funname}{group_status}: no rows removed"))
} else if (n == nrow(.data)) {
display(glue::glue("{funname}{group_status}: removed all rows (100%)"))
display(glue::glue("{.funname}{group_status}: removed all rows (100%)"))
} else {
total <- nrow(.data)
display(glue::glue("{funname}{group_status}: removed {n} rows ",
display(glue::glue("{.funname}{group_status}: removed {n} rows ",
"({percent(n, {total})}), {nrow(newdata)} remaining"))
}
newdata
Expand Down
14 changes: 7 additions & 7 deletions R/group_by.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,35 +10,35 @@
#' @import dplyr
#' @export
group_by <- function(.data, ...) {
log_group_by(.data, dplyr::group_by, "group_by", ...)
log_group_by(.data, .fun = dplyr::group_by, .funname = "group_by", ...)
}

#' @rdname group_by
#' @export
group_by_all <- function(.data, ...) {
log_group_by(.data, dplyr::group_by_all, "group_by_all", ...)
log_group_by(.data, .fun = dplyr::group_by_all, .funname = "group_by_all", ...)
}

#' @rdname group_by
#' @export
group_by_if <- function(.data, ...) {
log_group_by(.data, dplyr::group_by_if, "group_by_if", ...)
log_group_by(.data, .fun = dplyr::group_by_if, .funname = "group_by_if", ...)
}

#' @rdname group_by
#' @export
group_by_at <- function(.data, ...) {
log_group_by(.data, dplyr::group_by_at, "group_by_at", ...)
log_group_by(.data, .fun = dplyr::group_by_at, .funname = "group_by_at", ...)
}

log_group_by <- function(.data, fun, funname, ...) {
newdata <- fun(.data, ...)
log_group_by <- function(.data, .fun, .funname, ...) {
newdata <- .fun(.data, ...)
if (!"data.frame" %in% class(.data) | !should_display()) {
return(newdata)
}
group_vars <- get_groups(newdata)
display(glue::glue(
"{funname}: {plural(length(group_vars), 'grouping variable')} ",
"{.funname}: {plural(length(group_vars), 'grouping variable')} ",
"({format_list(group_vars)})"))
newdata
}
20 changes: 10 additions & 10 deletions R/join.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,41 +13,41 @@
#' @import dplyr
#' @export
inner_join <- function(x, ...) {
log_join(x, dplyr::inner_join, "inner_join", ...)
log_join(x, .fun = dplyr::inner_join, .funname = "inner_join", ...)
}

#' @rdname inner_join
#' @export
full_join <- function(x, ...) {
log_join(x, dplyr::full_join, "full_join", ...)
log_join(x, .fun = dplyr::full_join, .funname = "full_join", ...)
}

#' @rdname inner_join
#' @export
left_join <- function(x, ...) {
log_join(x, dplyr::left_join, "left_join", ...)
log_join(x, .fun = dplyr::left_join, .funname = "left_join", ...)
}

#' @rdname inner_join
#' @export
right_join <- function(x, ...) {
log_join(x, dplyr::right_join, "right_join", ...)
log_join(x, .fun = dplyr::right_join, .funname = "right_join", ...)
}

#' @rdname inner_join
#' @export
anti_join <- function(x, ...) {
log_join(x, dplyr::anti_join, "anti_join", ...)
log_join(x, .fun = dplyr::anti_join, .funname = "anti_join", ...)
}

#' @rdname inner_join
#' @export
semi_join <- function(x, ...) {
log_join(x, dplyr::semi_join, "semi_join", ...)
log_join(x, .fun = dplyr::semi_join, .funname = "semi_join", ...)
}

log_join <- function(x, fun, funname, ...) {
newdata <- fun(x, ...)
log_join <- function(x, .fun, .funname, ...) {
newdata <- .fun(x, ...)
if (!"data.frame" %in% class(x) | !should_display()) {
return(newdata)
}
Expand All @@ -58,10 +58,10 @@ log_join <- function(x, fun, funname, ...) {
cols <- setdiff(names(newdata), names(x))

if (length(cols) == 0) {
display(glue::glue("{funname}: {text_rows} {plural(n_rows, 'row')} and ",
display(glue::glue("{.funname}: {text_rows} {plural(n_rows, 'row')} and ",
"added no new columns"))
} else {
display(glue::glue("{funname}: {text_rows} {plural(n_rows, 'row')} and ",
display(glue::glue("{.funname}: {text_rows} {plural(n_rows, 'row')} and ",
"added {plural(length(cols), 'column')} ({format_list(cols)})"))
}

Expand Down
44 changes: 22 additions & 22 deletions R/mutate.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,25 +12,25 @@
#' @import dplyr
#' @export
mutate <- function(.data, ...) {
log_mutate(.data, dplyr::mutate, "mutate", ...)
log_mutate(.data, .fun = dplyr::mutate, .funname = "mutate", ...)
}

#' @rdname mutate
#' @export
mutate_all <- function(.data, ...) {
log_mutate(.data, dplyr::mutate_all, "mutate_all", ...)
log_mutate(.data, .fun = dplyr::mutate_all, .funname = "mutate_all", ...)
}

#' @rdname mutate
#' @export
mutate_if <- function(.data, ...) {
log_mutate(.data, dplyr::mutate_if, "mutate_if", ...)
log_mutate(.data, .fun = dplyr::mutate_if, .funname = "mutate_if", ...)
}

#' @rdname mutate
#' @export
mutate_at <- function(.data, ...) {
log_mutate(.data, dplyr::mutate_at, "mutate_at", ...)
log_mutate(.data, .fun = dplyr::mutate_at, .funname = "mutate_at", ...)
}

#' Wrapper around dplyr::transmute and related functions
Expand All @@ -46,57 +46,57 @@ mutate_at <- function(.data, ...) {
#' @import dplyr
#' @export
transmute <- function(.data, ...) {
log_mutate(.data, dplyr::transmute, "transmute", ...)
log_mutate(.data, .fun = dplyr::transmute, .funname = "transmute", ...)
}

#' @rdname transmute
#' @export
transmute_all <- function(.data, ...) {
log_mutate(.data, dplyr::transmute_all, "transmute_all", ...)
log_mutate(.data, .fun = dplyr::transmute_all, .funname = "transmute_all", ...)
}

#' @rdname transmute
#' @export
transmute_if <- function(.data, ...) {
log_mutate(.data, dplyr::transmute_if, "transmute_if", ...)
log_mutate(.data, .fun = dplyr::transmute_if, .funname = "transmute_if", ...)
}

#' @rdname transmute
#' @export
transmute_at <- function(.data, ...) {
log_mutate(.data, dplyr::transmute_at, "transmute_at", ...)
log_mutate(.data, .fun = dplyr::transmute_at, .funname = "transmute_at", ...)
}

#' @rdname mutate
#' @export
add_tally <- function(.data, ...) {
log_mutate(.data, dplyr::add_tally, "add_tally", ...)
log_mutate(.data, .fun = dplyr::add_tally, .funname = "add_tally", ...)
}

#' @rdname mutate
#' @export
add_count <- function(.data, ...) {
log_mutate(.data, dplyr::add_count, "add_count", ...)
log_mutate(.data, .fun = dplyr::add_count, .funname = "add_count", ...)
}

log_mutate <- function(.data, fun, funname, ...) {
log_mutate <- function(.data, .fun, .funname, ...) {
cols <- names(.data)
newdata <- fun(.data, ...)
newdata <- .fun(.data, ...)

if (!"data.frame" %in% class(.data) | !should_display()) {
return(newdata)
}

group_status <- ifelse(dplyr::is.grouped_df(newdata), " (grouped)", "")

if (grepl("transmute", funname)) {
if (grepl("transmute", .funname)) {
dropped_vars <- setdiff(names(.data), names(newdata))
n <- length(dropped_vars)
if (ncol(newdata) == 0) {
display(glue::glue("{funname}{group_status}: dropped all variables"))
display(glue::glue("{.funname}{group_status}: dropped all variables"))
return(newdata)
} else if (length(dropped_vars) > 0) {
display(glue::glue("{funname}{group_status}: dropped {plural(n, 'variable')}",
display(glue::glue("{.funname}{group_status}: dropped {plural(n, 'variable')}",
" ({format_list(dropped_vars)})"))
}
}
Expand All @@ -108,7 +108,7 @@ log_mutate <- function(.data, fun, funname, ...) {
has_changed <- TRUE
n <- length(unique(newdata[[var]]))
p_na <- percent(sum(is.na(newdata[[var]])), length(newdata[[var]]))
display(glue::glue("{funname}{group_status}: new variable '{var}' ",
display(glue::glue("{.funname}{group_status}: new variable '{var}' ",
"with {plural(n, 'value', 'unique ')} and {p_na} NA"))
} else {
# existing var
Expand Down Expand Up @@ -140,26 +140,26 @@ log_mutate <- function(.data, fun, funname, ...) {
new_na <- sum(is.na(new)) - sum(is.na(old))
na_text <- glue::glue("{abs(new_na)} ",
ifelse(new_na >= 0, "new", "fewer"), " NA")
display(glue::glue("{funname}{group_status}: changed {plural(n, 'value')} ",
display(glue::glue("{.funname}{group_status}: changed {plural(n, 'value')} ",
"({p}) of '{var}' ({na_text})"))
} else {
# different type
new_na <- sum(is.na(new)) - sum(is.na(old))
if (new_na == length(new)) {
display(glue::glue("{funname}{group_status}: converted '{var}' from {typeold} ",
"to {typenew} (now 100% NA)"))
display(glue::glue("{.funname}{group_status}: converted '{var}' from {typeold}",
" to {typenew} (now 100% NA)"))
} else {
na_text <- glue::glue("{abs(new_na)} ",
ifelse(new_na >= 0, "new", "fewer"), " NA")
display(glue::glue("{funname}{group_status}: converted '{var}' from {typeold} ",
"to {typenew} ({na_text})"))
display(glue::glue("{.funname}{group_status}: converted '{var}' from {typeold}",
" to {typenew} ({na_text})"))
}
}
}
}

if (!has_changed) {
display(glue::glue("{funname}{group_status}: no changes"))
display(glue::glue("{.funname}{group_status}: no changes"))
}
newdata
}
16 changes: 8 additions & 8 deletions R/select.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,39 +12,39 @@
#' @import dplyr
#' @export
select <- function(.data, ...) {
log_select(.data, dplyr::select, "select", ...)
log_select(.data, .fun = dplyr::select, .funname = "select", ...)
}

#' @rdname select
#' @export
select_all <- function(.data, ...) {
log_select(.data, dplyr::select_all, "select_all", ...)
log_select(.data, .fun = dplyr::select_all, .funname = "select_all", ...)
}

#' @rdname select
#' @export
select_if <- function(.data, ...) {
log_select(.data, dplyr::select_if, "select_if", ...)
log_select(.data, .fun = dplyr::select_if, .funname = "select_if", ...)
}

#' @rdname select
#' @export
select_at <- function(.data, ...) {
log_select(.data, dplyr::select_at, "select_at", ...)
log_select(.data, .fun = dplyr::select_at, .funname = "select_at", ...)
}

log_select <- function(.data, fun, funname, ...) {
log_select <- function(.data, .fun, .funname, ...) {
cols <- names(.data)
newdata <- fun(.data, ...)
newdata <- .fun(.data, ...)
if (!"data.frame" %in% class(.data) | !should_display()) {
return(newdata)
}
dropped_vars <- setdiff(cols, names(newdata))
n <- length(dropped_vars)
if (ncol(newdata) == 0) {
display(glue::glue("{funname}: dropped all variables"))
display(glue::glue("{.funname}: dropped all variables"))
} else if (length(dropped_vars) > 0) {
display(glue::glue("{funname}: dropped {plural(n, 'variable')}",
display(glue::glue("{.funname}: dropped {plural(n, 'variable')}",
" ({format_list(dropped_vars)})"))
}
newdata
Expand Down
Loading

0 comments on commit 6fa742e

Please sign in to comment.