top_n() uses tidy evaluation for n, +top_frac()

closes #4017

NAMESPACE

@@ -440,6 +440,7 @@ export(tbl_nongroup_vars)
 export(tbl_sum)
 export(tbl_vars)
 export(tibble)
+export(top_frac)
 export(top_n)
 export(transmute)
 export(transmute_)

NEWS.md

@@ -1,5 +1,9 @@
 # dplyr 0.8.1.9000
 
+* `top_n()` quotes its `n` argument. 
+
+* `top_frac(data, proportion)` is a shorthand for `top_n(data, proportion * n())` (#4017).  
+
 * `group_by()` puts NA groups last in character vectors (#4227).
 
 * `first()`, `last()` and `nth()` hybrid version handles factors (#4295).

R/top-n.R

@@ -5,24 +5,33 @@
 #' ordered by `wt`.
 #'
 #' @param x a [tbl()] to filter
-#' @param n number of rows to return. If `x` is grouped, this is the
-#'   number of rows per group. Will include more than `n` rows if
+#' @param n number of rows to return for `top_n()`, fraction of rows to
+#'   return for `top_frac()`.
+#'
+#'   If `x` is grouped, this is the
+#'   number (or fraction) of rows per group. Will include more rows if
 #'   there are ties.
 #'
-#'   If `n` is positive, selects the top `n` rows. If negative,
-#'   selects the bottom `n` rows.
+#'   If `n` is positive, selects the top rows. If negative,
+#'   selects the bottom rows.
+#'
 #' @param wt (Optional). The variable to use for ordering. If not
 #'   specified, defaults to the last variable in the tbl.
 #'
-#'   This argument is automatically [quoted][rlang::quo] and later
+#' @details
+#'   Both `n` and `wt` are automatically [quoted][rlang::quo] and later
 #'   [evaluated][rlang::eval_tidy] in the context of the data
-#'   frame. It supports [unquoting][rlang::quasiquotation]. See
-#'   `vignette("programming")` for an introduction to these concepts.
+#'   frame. It supports [unquoting][rlang::quasiquotation].
+#'
 #' @export
 #' @examples
 #' df <- data.frame(x = c(10, 4, 1, 6, 3, 1, 1))
 #' df %>% top_n(2)
 #'
+#' # half the rows
+#' df %>% top_n(n() * .5)
+#' df %>% top_frac(.5)
+#'
 #' # Negative values select bottom from group. Note that we get more
 #' # than 2 values here because there's a tie: top_n() either takes
 #' # all rows with a value, or none.
@@ -40,6 +49,7 @@
 #' tbl_df(Batting) %>% group_by(playerID) %>% top_n(1, G)
 #' }
 top_n <- function(x, n, wt) {
+  nn <- enquo(n)
   wt <- enquo(wt)
 
   if (quo_is_missing(wt)) {
@@ -49,15 +59,19 @@ top_n <- function(x, n, wt) {
     wt <- sym(wt_name)
   }
 
-  if (!is_scalar_integerish(n)) {
-    abort("`n` must be a scalar integer")
-  }
-
-  if (n > 0) {
-    quo <- quo(filter(x, min_rank(desc(!!wt)) <= !!n))
-  } else {
-    quo <- quo(filter(x, min_rank(!!wt) <= !!abs(n)))
-  }
+  pred <- quo(local({
+    .n <- !!nn
+    if (.n > 0) {
+      min_rank(desc(!!wt)) <= .n
+    } else {
+      min_rank(!!wt) <= abs(.n)
+    }
+  }))
+  filter(x, !!pred)
+}
 
-  eval_tidy(quo)
+#' @export
+#' @rdname top_n
+top_frac <- function(x, n, wt) {
+  top_n(x, !!enquo(n) * n(), !!enquo(wt))
 }

tests/testthat/test-top-n.R

@@ -17,3 +17,16 @@ test_that("top_n() handles missing `wt`", {
 test_that("top_n() handles calls", {
   expect_identical(top_n(mtcars, 2, -disp), top_n(mtcars, -2, disp))
 })
+
+test_that("top_n() quotes n", {
+  expect_identical(top_n(mtcars, n() * .5), top_n(mtcars, 16))
+})
+
+test_that("top_frac() is a shorthand for top_n(n()*)", {
+  expect_identical(top_n(mtcars, n() * .5, disp), top_frac(mtcars, .5, disp))
+
+  expect_message(
+    regexp = "Selecting by carb",
+    expect_identical(top_n(mtcars, n() * .5), top_frac(mtcars, .5))
+  )
+})