Skip to content

Commit

Permalink
Merge branch 'master' into 4106-tbl_vars
Browse files Browse the repository at this point in the history
  • Loading branch information
romainfrancois authored Jun 12, 2019
2 parents 2711029 + 19aa821 commit af3631f
Show file tree
Hide file tree
Showing 9 changed files with 91 additions and 29 deletions.
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -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_)
Expand Down
4 changes: 4 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,10 @@

* `tbl_vars()` keeps information on grouping columns (#4106).

* `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).
Expand Down
10 changes: 10 additions & 0 deletions R/case_when.R
Original file line number Diff line number Diff line change
Expand Up @@ -75,6 +75,16 @@
#' x %% 7 == 0 ~ 7,
#' TRUE ~ NA_real_
#' )
#'
#' # case_when() evaluates all RHS expressions, and then constructs its
#' # result by extracting the selected (via the LHS expressions) parts.
#' # In particular NaN are produced in this case:
#' y <- seq(-2, 2, by = .5)
#' case_when(
#' y >= 0 ~ sqrt(y),
#' TRUE ~ y
#' )
#'
#' # This throws an error as NA is logical not numeric
#' \dontrun{
#' case_when(
Expand Down
2 changes: 1 addition & 1 deletion R/count-tally.R
Original file line number Diff line number Diff line change
Expand Up @@ -72,7 +72,7 @@
#' starwars %>%
#' add_count(species) %>%
#' filter(n == 1)
tally <- function(x, wt, sort = FALSE, name = "n") {
tally <- function(x, wt = NULL, sort = FALSE, name = "n") {
wt <- enquo(wt)

if (quo_is_missing(wt) && "n" %in% tbl_vars(x)) {
Expand Down
48 changes: 31 additions & 17 deletions R/top-n.R
Original file line number Diff line number Diff line change
Expand Up @@ -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::enquo] 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.
Expand All @@ -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)) {
Expand All @@ -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 <- expr(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))
}
10 changes: 10 additions & 0 deletions man/case_when.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/tally.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

30 changes: 20 additions & 10 deletions man/top_n.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

13 changes: 13 additions & 0 deletions tests/testthat/test-top-n.R
Original file line number Diff line number Diff line change
Expand Up @@ -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))
)
})

0 comments on commit af3631f

Please sign in to comment.