この問題を解決するために2つのトリックを提案します。下部にある両方のソリューションのコードと詳細を参照してください。
機能.at
変数のグループ(グループによる、ここで1つの変数のみ)用のために結果を返しますが、私たちは、その後、私たちはunsplice両方の世界の恩恵を受け、できることということsummarize
とsummarize_at
:
df %>% summarize(
!!!.at(vars(potentially_long_name_i_dont_want_to_type_twice), mean),
!!!.at(vars(another_annoyingly_long_name), sum))
# # A tibble: 1 x 2
# potentially_long_name_i_dont_want_to_type_twice another_annoyingly_long_name
# <dbl> <dbl>
# 1 5.5 255
の副詞summarize
、ドル表記の省略形。
df %>%
..flx$summarize(potentially_long_name_i_dont_want_to_type_twice = ~mean(.),
another_annoyingly_long_name = ~sum(.))
# # A tibble: 1 x 2
# potentially_long_name_i_dont_want_to_type_twice another_annoyingly_long_name
# <dbl> <int>
# 1 5.5 255
のコード .at
.
親環境で使用するため、パイプで使用する必要があります。面倒ですが、機能します。
.at <- function(.vars, .funs, ...) {
in_a_piped_fun <- exists(".",parent.frame()) &&
length(ls(envir=parent.frame(), all.names = TRUE)) == 1
if (!in_a_piped_fun)
stop(".at() must be called as an argument to a piped function")
.tbl <- try(eval.parent(quote(.)))
dplyr:::manip_at(
.tbl, .vars, .funs, rlang::enquo(.funs), rlang:::caller_env(),
.include_group_vars = TRUE, ...)
}
私は結合することを設計さsummarize
とsummarize_at
:
df %>% summarize(
!!!.at(vars(potentially_long_name_i_dont_want_to_type_twice), list(foo=min, bar = max)),
!!!.at(vars(another_annoyingly_long_name), median))
# # A tibble: 1 x 3
# foo bar another_annoyingly_long_name
# <dbl> <dbl> <dbl>
# 1 1 10 25.5
のコード ..flx
..flx
実行前のa = ~mean(.)
呼び出しなどによって、数式引数を置き換える関数を出力しますa = purrr::as_mapper(~mean(.))(a)
。便利summarize
とmutate
矛盾がないことができるようにカラムためには、式にすることはできません。
私はドル表記を省略形として使用し、名前を最初に付けるの..
が好きです。そうすれば、それらの「タグ」に名前を付けて(そしてそれらにクラスを付けて"tag"
)、それらを異なるオブジェクトとして見ることができます(まだこれを試しています)。..flx(summarize)(...)
ただし、同様に機能します。
..flx <- function(fun){
function(...){
mc <- match.call()
mc[[1]] <- tail(mc[[1]],1)[[1]]
mc[] <- imap(mc,~if(is.call(.) && identical(.[[1]],quote(`~`))) {
rlang::expr(purrr::as_mapper(!!.)(!!sym(.y)))
} else .)
eval.parent(mc)
}
}
class(..flx) <- "tag"
`$.tag` <- function(e1, e2){
# change original call so x$y, which is `$.tag`(tag=x, data=y), becomes x(y)
mc <- match.call()
mc[[1]] <- mc[[2]]
mc[[2]] <- NULL
names(mc) <- NULL
# evaluate it in parent env
eval.parent(mc)
}