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

时间:2018-06-14 06:30:34

标签: r dplyr

我在选择由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_rn1ratio1_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)))

1 个答案:

答案 0 :(得分:2)

我们可以创建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

或者,我们可以map临时对象“{1}}而不是多个unnest。格式

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