Применение purrr :: map2 к двум столбцам вложенного тиббла - PullRequest
Новая
       9

Применение purrr :: map2 к двум столбцам вложенного тиббла

0 голосов
/ 23 марта 2020

Этот вопрос касается работы на языке tidyverse. Я пытаюсь использовать tidyr::nest и purrr:map2 для выполнения двумерной функции над двумя столбцами tibble, заменяя их двумя другими столбцами, которые являются результатом этой двумерной функции. Операция заключается в вычислении RO C на основе значений statisti c в H0 и H1, что дает два новых значения (то есть столбцы) 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, передавая их через функцию 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 подход.

1 Ответ

1 голос
/ 23 марта 2020

Вы были в правильном направлении, но вам пришлось unlist в функции map2 вместо аргументов. 

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
...