Merge branch 'master' into b-tidyverse#2033-join-na

DESCRIPTION

@@ -21,7 +21,7 @@ Imports:
     magrittr,
     methods,
     pkgconfig,
-    rlang,
+    rlang (>= 0.0.0.9001),
     R6,
     Rcpp (>= 0.12.6),
     tibble (>= 1.2),

NEWS.md

@@ -8,6 +8,10 @@
   The default can also be tweaked by calling
   `pkgconfig::set_config("dplyr::na_matches", "na")` (#2033).
 
+* `summarise()` now correctly evaluates newly created factors (#2217).
+
+* `summarise()` now can create ordered factors (#2200).
+
 * `bind_rows()` and `bind_cols()` give an error for database tables (#2373).
 
 * `bind_rows()` works correctly with `NULL` arguments and an `.id` argument

R/bind.r

@@ -141,7 +141,7 @@ is_data_list <- function(x) {
     return(TRUE)
 
   # With names
-  if (any(!have_names(x)))
+  if (any(!have_name(x)))
     return(FALSE)
 
   # Where each element is an 1d vector or list

R/colwise.R

@@ -118,7 +118,7 @@ probe_colwise_names <- function(tbl, p, ...) {
 
   vars <- tbl_vars(tbl)
   vars <- vars[selected]
-  symbols(vars)
+  syms(vars)
 }
 
 #' @rdname summarise_all
@@ -162,19 +162,19 @@ summarize_if <- summarise_if
 #' @seealso [summarise_all()]
 #' @export
 vars <- function(...) {
-  structure(tidy_quotes(...), class = "col_list")
+  structure(dots_quosures(...), class = "col_list")
 }
 is_col_list <- function(cols) inherits(cols, "col_list")
 
 select_colwise_names <- function(tbl, cols) {
   vars <- tbl_vars(tbl)
 
   if (is_character(cols)) {
-    selected <- symbols(cols)
+    selected <- syms(cols)
   } else if (is_col_list(cols)) {
     selected <- cols
   } else if (is.numeric(cols)) {
-    selected <- symbols(vars[cols])
+    selected <- syms(vars[cols])
   } else {
     abort(".cols should be a character/numeric vector or a columns object")
   }
@@ -186,16 +186,16 @@ select_colwise_names <- function(tbl, cols) {
 apply_vars <- function(funs, vars, tbl) {
   stopifnot(is_fun_list(funs))
 
-  named_calls <- attr(funs, "have_names")
-  named_vars <- any(have_names(vars))
+  named_calls <- attr(funs, "have_name")
+  named_vars <- any(have_name(vars))
   vars <- select_vars(tbl_vars(tbl), !!! vars, exclude = group_vars(tbl))
 
   out <- vector("list", length(vars) * length(funs))
   dim(out) <- c(length(vars), length(funs))
 
   for (i in seq_along(vars)) {
     for (j in seq_along(funs)) {
-      var_sym <- symbol(vars[[i]])
+      var_sym <- sym(vars[[i]])
       out[[i, j]] <- expr_substitute(funs[[j]], quote(.), var_sym)
     }
   }
@@ -233,7 +233,7 @@ apply_vars <- function(funs, vars, tbl) {
 #'   be either a list of expressions or a character vector.
 #' @export
 summarise_each <- function(tbl, funs, ...) {
-  summarise_each_(tbl, funs, tidy_quotes(...))
+  summarise_each_(tbl, funs, dots_quosures(...))
 }
 
 #' @export
@@ -269,7 +269,7 @@ mutate_each <- function(tbl, funs, ...) {
     funs <- funs_(funs)
   }
 
-  mutate_each_(tbl, funs, tidy_quotes(...))
+  mutate_each_(tbl, funs, dots_quosures(...))
 }
 
 #' @export

R/compat-lazyeval.R

@@ -9,7 +9,7 @@ warn_underscored <- function() {
   warn(paste(
     "The underscored versions are deprecated in favour of",
     "tidy evaluation idioms. Please see the documentation",
-    "for `tidy_quote()` in rlang"
+    "for `quosure()` in rlang"
   ))
 }
 warn_text_se <- function() {
@@ -20,17 +20,17 @@ warn_text_se <- function() {
 compat_lazy <- function(lazy, env = caller_env(), warn = TRUE) {
   if (warn) warn_underscored()
 
-  coerce_type(lazy, "tidy_quote",
-    quote = lazy,
+  coerce_type(lazy, "quosure",
+    quosure = lazy,
     symbol = ,
-    language = quosure(lazy, env),
+    language = new_quosure(lazy, env),
     string = {
       if (warn) warn_text_se()
-      parse_f(lazy, env)
+      parse_quosure(lazy, env)
     },
     list =
-      coerce_class(lazy, "tidy_quote",
-        lazy = quosure(lazy$expr, lazy$env)
+      coerce_class(lazy, "quosure",
+        lazy = new_quosure(lazy$expr, lazy$env)
       )
   )
 }
@@ -48,7 +48,7 @@ compat_lazy_dots <- function(dots, env, ..., .named = FALSE) {
     warn <- FALSE
   }
 
-  named <- have_names(dots)
+  named <- have_name(dots)
   if (.named && any(!named)) {
     nms <- map_chr(dots[!named], f_text)
     names(dots)[!named] <- nms
@@ -65,7 +65,7 @@ compat_as_lazy <- function(quo) {
   ))
 }
 compat_as_lazy_dots <- function(...) {
-  structure(class = "lazy_dots", map(tidy_quotes(...), compat_as_lazy))
+  structure(class = "lazy_dots", map(dots_quosures(...), compat_as_lazy))
 }
 
 

R/count-tally.R

@@ -64,12 +64,12 @@ tally <- function(x, wt = NULL, sort = FALSE) {
     inform("Using `n` as weighting variable")
     wt <- ~n
   } else {
-    wt <- tidy_capture(wt)
+    wt <- catch_quosure(wt)
   }
 
   # Check for NULL lazily, because `wt` could be a tidy-quoted NULL if
   # add_tally() is called from another function (e.g. add_count())
-  n <- tidy_quote(
+  n <- quosure(
     if (is_null(!! wt)) {
       n()
     } else {
@@ -81,7 +81,7 @@ tally <- function(x, wt = NULL, sort = FALSE) {
   out <- summarise(x, !! n_name := !! n)
 
   if (sort) {
-    arrange(out, desc(!! symbol(n_name)))
+    arrange(out, desc(!! sym(n_name)))
   } else {
     out
   }
@@ -111,7 +111,7 @@ count <- function(x, ..., wt = NULL, sort = FALSE) {
 
   x <- group_by(x, ..., add = TRUE)
   x <- tally(x, wt = !! wt, sort = sort)
-  x <- group_by(x, !!! symbols(groups), add = FALSE)
+  x <- group_by(x, !!! syms(groups), add = FALSE)
   x
 }
 #' @export
@@ -128,12 +128,12 @@ add_tally <- function(x, wt = NULL, sort = FALSE) {
     inform("Using `n` as weighting variable")
     wt <- ~n
   } else {
-    wt <- tidy_capture(wt)
+    wt <- catch_quosure(wt)
   }
 
   # Check for NULL lazily, because `wt` could be a tidy-quoted NULL if
   # add_tally() is called from another function (e.g. add_count())
-  n <- tidy_quote(
+  n <- quosure(
     if (is_null(!! wt)) {
       n()
     } else {
@@ -145,7 +145,7 @@ add_tally <- function(x, wt = NULL, sort = FALSE) {
   out <- mutate(x, !! n_name := !! n)
 
   if (sort) {
-    out <- arrange(out, desc(!! symbol(n_name)))
+    out <- arrange(out, desc(!! sym(n_name)))
   }
 
   grouped_df(out, group_vars(x))
@@ -164,7 +164,7 @@ add_count <- function(x, ..., wt = NULL, sort = FALSE) {
   g <- group_vars(x)
   grouped <- group_by(x, ..., add = TRUE)
 
-  out <- add_tally(grouped, wt = !! tidy_capture(wt), sort = sort)
+  out <- add_tally(grouped, wt = !! catch_quosure(wt), sort = sort)
   grouped_df(out, g)
 }
 #' @rdname se-deprecated

R/dataframe.R

@@ -68,7 +68,7 @@ filter_.data.frame <- function(.data, ..., .dots = list()) {
 
 #' @export
 slice.data.frame <- function(.data, ...) {
-  dots <- tidy_quotes(..., .named = TRUE)
+  dots <- dots_quosures(..., .named = TRUE)
   slice_impl(.data, dots)
 }
 #' @export
@@ -192,19 +192,19 @@ distinct_.data.frame <- function(.data, ..., .dots = list(), .keep_all = FALSE)
 
 #' @export
 do.data.frame <- function(.data, ...) {
-  args <- tidy_quotes(...)
+  args <- dots_quosures(...)
   named <- named_args(args)
 
   # Create custom dynamic scope with `.` pronoun
   overscope <- child_env(data = list(. = .data, .data = .data))
 
   if (!named) {
-    out <- tidy_eval_(args[[1]], overscope)
+    out <- eval_tidy_(args[[1]], overscope)
     if (!inherits(out, "data.frame")) {
       abort("Result must be a data frame")
     }
   } else {
-    out <- map(args, function(arg) list(tidy_eval_(arg, overscope)))
+    out <- map(args, function(arg) list(eval_tidy_(arg, overscope)))
     names(out) <- names(args)
     out <- tibble::as_tibble(out, validate = FALSE)
   }

R/distinct.R

@@ -44,7 +44,7 @@ distinct_ <- function(.data, ..., .dots, .keep_all = FALSE) {
 #' vars (character vector) comes out.
 #' @noRd
 distinct_vars <- function(.data, ..., .dots, .keep_all = FALSE) {
-  dots <- tidy_quotes(..., .named = TRUE)
+  dots <- dots_quosures(..., .named = TRUE)
 
   # If no input, keep all variables
   if (length(dots) == 0) {

R/funs.R

@@ -22,7 +22,7 @@
 #' fs <- c("min", "max")
 #' funs_(fs)
 funs <- function(..., .args = list()) {
-  dots <- tidy_quotes(...)
+  dots <- dots_quosures(...)
   dots <- map(dots, funs_make_call, args = .args)
 
   names(dots) <- names2(dots)
@@ -31,7 +31,7 @@ funs <- function(..., .args = list()) {
   names(dots)[missing_names] <- default_names
 
   class(dots) <- "fun_list"
-  attr(dots, "have_names") <- any(!missing_names)
+  attr(dots, "have_name") <- any(!missing_names)
   dots
 }
 
@@ -95,10 +95,10 @@ funs_make_call <- function(x, args, env = base_env()) {
   expr <- get_expr(x)
 
   expr <- switch_type(expr, "funs",
-    quote = ,
+    quosure = ,
     language = expr,
     symbol = substitute(f(.), list(f = expr)),
-    string = substitute(f(.), list(f = symbol(expr)))
+    string = substitute(f(.), list(f = sym(expr)))
   )
 
   expr <- lang_modify(expr, .args = args)

R/group-by.r

@@ -95,11 +95,11 @@ group_by_ <- function(.data, ..., .dots = list(), add = FALSE) {
 #' @export
 #' @keywords internal
 group_by_prepare <- function(.data, ..., .dots = list(), add = FALSE) {
-  new_groups <- c(tidy_quotes(...), .dots)
+  new_groups <- c(dots_quosures(...), .dots)
 
   # If any calls, use mutate to add new columns, then group by those
   is_symbol <- map_lgl(new_groups, is_symbol)
-  named <- have_names(new_groups)
+  named <- have_name(new_groups)
 
   needs_mutate <- named | !is_symbol
   if (any(needs_mutate)) {
@@ -117,7 +117,7 @@ group_by_prepare <- function(.data, ..., .dots = list(), add = FALSE) {
 
   list(
     data = .data,
-    groups = symbols(group_names),
+    groups = syms(group_names),
     group_names = group_names
   )
 }

R/group-indices.R

@@ -24,7 +24,7 @@ group_indices_ <- function(.data, ..., .dots = list()) {
 
 #' @export
 group_indices.data.frame <- function(.data, ...) {
-  dots <- tidy_quotes(...)
+  dots <- dots_quosures(...)
   if (length(dots) == 0L) {
     return(rep(1L, nrow(.data)))
   }

R/grouped-df.r

@@ -171,7 +171,7 @@ do.grouped_df <- function(.data, ...) {
   # Create ungroup version of data frame suitable for subsetting
   group_data <- ungroup(.data)
 
-  args <- tidy_quotes(...)
+  args <- dots_quosures(...)
   named <- named_args(args)
   env <- child_env(NULL)
 
@@ -186,7 +186,7 @@ do.grouped_df <- function(.data, ...) {
       out <- label_output_list(labels, out, groups(.data))
     } else {
       env_bind(env, list(. = group_data, .data = group_data))
-      out <- tidy_eval_(args[[1]], env)[0, , drop = FALSE]
+      out <- eval_tidy_(args[[1]], env)[0, , drop = FALSE]
       out <- label_output_dataframe(labels, list(list(out)), groups(.data))
     }
     return(out)

R/hybrid.R

@@ -7,7 +7,7 @@ verify_not_hybrid <- function(x) {
 }
 
 with_hybrid <- function(expr, ...) {
-  with_hybrid_(tidy_capture(expr), ...)
+  with_hybrid_(catch_quosure(expr), ...)
 }
 
 with_hybrid_ <- function(expr, ...) {
@@ -24,7 +24,7 @@ with_hybrid_ <- function(expr, ...) {
 }
 
 without_hybrid <- function(expr, ...) {
-  without_hybrid_(tidy_capture(expr), ...)
+  without_hybrid_(catch_quosure(expr), ...)
 }
 
 without_hybrid_ <- function(expr, ...) {
@@ -41,7 +41,7 @@ without_hybrid_ <- function(expr, ...) {
 }
 
 eval_dots <- function(expr, ...) {
-  eval_dots_(tidy_capture(expr), ...)
+  eval_dots_(catch_quosure(expr), ...)
 }
 
 eval_dots_ <- function(expr, ...) {

R/manip.r

@@ -239,7 +239,7 @@ transmute_ <- function(.data, ..., .dots = list()) {
 
 #' @export
 transmute.default <- function(.data, ...) {
-  dots <- tidy_quotes(..., .named = TRUE)
+  dots <- dots_quosures(..., .named = TRUE)
   out <- mutate(.data, !!! dots)
 
   keep <- names(dots)
@@ -366,7 +366,7 @@ select_if <- function(.data, .predicate, ...) {
   }
   vars <- probe_colwise_names(.data, .predicate, ...)
   vars <- ensure_grouped_vars(vars, .data, notify = FALSE)
-  select(.data, !!! symbols(vars))
+  select(.data, !!! syms(vars))
 }
 
 #' @rdname select