r-在嵌套tibble的两列上应用purrr::map2

Question

此问题涉及tidyverse语言中的操作。我正试图使用tidyr::nest和purrr:map2对tibble的两列执行二元函数，将它们替换为该二元函数的结果的另外两列。操作是基于H0和H1下的统计量的值来计算ROC，这产生两个新值(即列(FPR和TPR。下面是一个工作示例：

library(tidyverse)
library(purrr)
# function to compute the rejection rates
get_reject_freq <- function(Tstat, th_vec, twosided=T) {
# Tstat is a vector, th could be a vector of thresholds threshold
if (twosided) Tstat <- abs(Tstat)
sapply(th_vec, function(th) mean(Tstat > th))
}
# function to compute the ROC
get_ROC <- function(T0, T1, twosided=T) {
T0_sorted <- sort(unique(T0), decreasing = T)
tibble(FPR = get_reject_freq(T0, T0_sorted, twosided = twosided), 
TPR = get_reject_freq(T1, T0_sorted, twosided = twosided))
}
n = m = 15
run_sims_one_iter <- function(j) {
x = rt(n, df=5, ncp=0)
y = list(H0=rt(m, df=5, ncp=0), H1=rt(m, df=5, ncp=1))
result = NULL
for (h in c("H0","H1")) {
result[[h]] = tibble(method="t_test", H=h, 
test_stat=t.test(x,y[[h]])$statistic) %>% 
add_row(method="wilcoxon", H=h, 
test_stat=wilcox.test(x,y[[h]], alternative = "two.sided")$statistic, )
}
return( bind_rows(result) )
}
result = bind_rows( lapply(1:100, run_sims_one_iter) )

#### The following can hopefully be improved ###
temp = result %>% 
group_by(method,H) %>% 
nest() %>%
pivot_wider(names_from = H, values_from = data) %>%
ungroup()

roc_results = bind_rows( 
lapply(1:nrow(temp), function(i) {
get_ROC( temp[[i,"H0"]]$test_stat, temp[[i,"H1"]]$test_stat) %>% 
add_column(method = temp[i,]$method)
}
))

线路

temp = result %>% 
group_by(method,H) %>% 
nest() %>%
pivot_wider(names_from = H, values_from = data) %>%
ungroup()

生成以下形式的输出：

# A tibble: 2 x 3
method   H0                 H1                
<chr>    <list>             <list>            
1 t_test   <tibble [100 × 1]> <tibble [100 × 1]>
2 wilcoxon <tibble [100 × 1]> <tibble [100 × 1]>

代码应该对每一行进行操作，取H0和H1列中的两个tibble，通过get_ROC函数传递它们，然后用FPR和TPR列以及unnest所有内容替换它们。上述代码生成的期望roc_result是

roc_results
# A tibble: 157 x 3
FPR   TPR method
<dbl> <dbl> <chr> 
1  0.03  0.76 t_test
2  0.04  0.77 t_test
3  0.07  0.82 t_test
...

理想情况下，我想用形式的单行代替temp和roc_results的构造

temp = result %>% 
group_by(method,H) %>% 
nest() %>%
pivot_wider(names_from = H, values_from = data) %>%
ungroup() %>%
mutate(res=map2(unlist(H0), unlist(H1), get_ROC)) %>% unnest(res)

但这行不通。我想问题可能是get_ROC的输出大小可能每行都会发生变化(？(。知道我如何使用tidyverse方法执行所有操作吗。

Answer 1

你的方向是正确的，但你必须在map2的函数中unlist，而不是在参数中。

library(dplyr)
library(tidyr)
result %>% 
group_by(method,H) %>% 
nest() %>%
pivot_wider(names_from = H, values_from = data) %>% 
mutate(res = purrr::map2(H0, H1, ~get_ROC(unlist(.x), unlist(.y)))) %>%
unnest(res) %>%
select(-c(H0, H1))
#  method   FPR   TPR
#   <chr>  <dbl> <dbl>
# 1 t_test  0.01  0.49
# 2 t_test  0.06  0.59
# 3 t_test  0.08  0.65
# 4 t_test  0.1   0.74
# 5 t_test  0.11  0.77
# 6 t_test  0.13  0.82
# 7 t_test  0.19  0.84
# 8 t_test  0.21  0.84
# 9 t_test  0.22  0.85
#10 t_test  0.24  0.86
# … with 156 more rows