在下一个 mutate_at 中选择由 mutate_at 创建的正确列

Question

我在选择mutate_at创建的特定变量时遇到问题。

所以我有几个分组比率，我想为这些比率计算某种边界。这可以通过mutate_at 轻松完成。但是我的下一步是使用这些列来计算更多的值，我无法以某种方式自动执行此列选择。有没有方便的方法？

set.seed(1)
df <- data.frame(label=letters[1:25],
                 group=rep(1:5, each=5),
                 ratio1=rnorm(25,1,.1),
                 ratio2=rnorm(25,1,.1))

df2 <- 
  df %>%
  group_by(group) %>%
  mutate_at(vars(ratio1, ratio2),
            funs(rn1=quantile(., probs=c(0.1587), na.rm=TRUE),
                 r0=quantile(., probs=c(0.5), na.rm=TRUE),
                 rp1=quantile(., probs=c(0.8413), na.rm=TRUE)))

这将创建一个数据框，在其中我得到每个比率对应的分位数列（如ratio1_rn1、ratio1_r0 等）。我现在需要使用相关列来计算重要性。我可以像下面这样手动对单个比率执行此操作，但我想再次使用mutate_at 执行此操作，并以某种方式选择正确的_rn1、_r0 和_rp1。

df2 %>%
  ungroup() %>%
  group_by(label) %>%
  mutate(ratio1_z=ifelse(ratio1 >= 0,
                  (ratio1-ratio1_r0)/(ratio1_rp1-ratio1_r0),
                  (ratio1-ratio1_r0)/(ratio1_rn1-ratio1_r0)),
         ratio1_sigB=.5*pracma::erfc(ratio1_z/sqrt(2)))

Answer 1

我们可以创建list 列，然后使用map 进行减法

library(tidyverse)
df2 <- df %>% 
           group_by(group) %>% 
           mutate_at(vars(ratio1, ratio2), 
             funs(new = list(quantile(., probs = c(0.1587, 0.5, 0.8413), 
                 na.rm = TRUE))))

df[paste0(names(df)[3:4], "_sigB")] <- map2(df2[3:4], df2[5:6],  ~
      .5 * pracma::erfc(
          ifelse(.x >= 0, 
            (.x - map_dbl(.y, `[`, 2))/(map_dbl(.y, ~ .x[[3]]-.x[[2]])),
            (.x - map_dbl(.y, `[`, 2)/map_dbl(.y, ~ .x[[1]] - .x[[2]])))/sqrt(2)))

head(df)
#  label group    ratio1    ratio2 ratio1_sigB ratio2_sigB
#1     a     1 0.9373546 0.9943871  0.90859016  0.35742468
#2     b     1 1.0183643 0.9844204  0.50000000  0.50000000
#3     c     1 0.9164371 0.8529248  0.95313974  0.99999928
#4     d     1 1.1595281 0.9521850  0.01013544  0.88133038
#5     e     1 1.0329508 1.0417942  0.40521962  0.01772576
#6     f     2 0.9179532 1.1358680  1.00000000  0.03800840

---

或者我们可以 unnest 将临时对象转换为“长”格式，而不是拥有多个 maps

df2 <- df %>% 
           group_by(group) %>%
           mutate_at(vars(ratio1, ratio2), 
             funs(new = list(quantile(., probs = c(0.1587, 0.5, 0.8413), 
                 na.rm = TRUE)))) %>%
           unnest 
out <- map2_df(df2[c('ratio1', 'ratio2')], 
               df2[c('ratio1_new', 'ratio2_new')], ~ 
               .5 * pracma::erfc(ifelse(.x > 0,
                (.x - .y[2])/(.y[3]- .y[2]),
                (.x- .y[2])/(.y[1] - .y[2]))/sqrt(2)) %>%
        `[`(c(TRUE, FALSE, FALSE))) %>% # recycling index to subset every 3rd
        rename_all(~ paste0(.x, "_sigB")) %>% 
        bind_cols(df, .) %>%
        as_tibble

head(out, 3)
# A tibble: 3 x 6
#  label group ratio1 ratio2 ratio1_sigB ratio2_sigB
#  <fct> <int>  <dbl>  <dbl>       <dbl>       <dbl>
#1 a         1  0.937  0.994       0.909       0.357
#2 b         1  1.02   0.984       0.5         0.5  
#3 c         1  0.916  0.853       0.953       1.000