использование функционалов с переменной, полученной из локальной среды в R (лексическая проблема объема) - PullRequest
0 голосов
/ 31 января 2019

Я работаю над проблемой типа классификации, используя некоторые симуляции, и хочу подсчитать количество истинных положительных результатов, ложных срабатываний и т. Д., Используя различные пороговые значения.Например, рассмотрим следующий пример:

library(tidyverse)

set.seed(23)
n <- 100
df <- tibble(
  class = sample(LETTERS[1:5], 100, replace = TRUE),
  pred_class = sample(LETTERS[1:5], 100, replace = TRUE),
  correct = class == pred_class,
  pval = runif(100, 0, 1)
) %>% 
  print()
#> # A tibble: 100 x 4
#>    class pred_class correct   pval
#>    <chr> <chr>      <lgl>    <dbl>
#>  1 C     E          FALSE   0.643 
#>  2 B     C          FALSE   0.561 
#>  3 B     C          FALSE   0.824 
#>  4 D     A          FALSE   0.971 
#>  5 E     A          FALSE   0.0283
#>  6 C     D          FALSE   0.723 
#>  7 E     D          FALSE   0.521 
#>  8 E     D          FALSE   0.619 
#>  9 E     E          TRUE    0.198 
#> 10 E     B          FALSE   0.386 
#> # ... with 90 more rows

Для фиксированной отсечки задача тривиальна (пожалуйста, не обращайте внимания на направление назначений, они верны для фактической задачи, над которой я работаю,но я признаю, что они могут появиться здесь задом наперед).Это то, что я пытаюсь выполнить, но с более чем 1 срезом:

df %>%
  summarize(
    cutoff = 0.05,
    TP = sum(!correct & pval < 0.05),
    FP = sum(correct & pval < 0.05),
    FN = sum(!correct & pval >= 0.05),
    TN = sum(correct & pval >= 0.05)
  )
#> # A tibble: 1 x 5
#>   cutoff    TP    FP    FN    TN
#>    <dbl> <int> <int> <int> <int>
#> 1   0.05     5     1    73    21

Но для нескольких срезов, скажем a <- c(0.01, 0.05, 0.1) или a <- seq(0, .15, 0.01), это много вырезок и вставок.Поэтому моя цель - выяснить, как это сделать с функционалами и (я думаю?) summarize_at.К сожалению, это вызывает у меня проблемы.

Я могу заставить это работать, когда суммы основаны на одной переменной.Это уродливо, но работает следующее:

# define the functionals (note only 2 since we are only looking at 1 variable)

a <- c(0.01, 0.05, 0.1)
pfun <- list(
  less_p = function(a) {function(p) sum(p < a)},
  more_p = function(a) {function(p) sum(p >= a)}
) %>%
  imap(~list(f = .x, label = .y))

fun_list <- cross(list(alpha = alpha, f = pfun)) %>% map(function(x) {
  list(
    f = x$f$f(x$alpha),
    label = paste(x$f$label, x$alpha, sep = "_")
  )
}) %>%
  set_names(., map_chr(., ~ .x$label)) %>%
  map(~ .x$f)

df %>%
  summarize_at(
    .vars = vars(pval),
    .funs = funs(!!!fun_list)
  )
#> # A tibble: 1 x 10
#>   less_p_0.01 less_p_0.02 less_p_0.03 less_p_0.04 less_p_0.05 more_p_0.01
#>         <int>       <int>       <int>       <int>       <int>       <int>
#> 1           1           3           4           4           6          99
#> # ... with 4 more variables: more_p_0.02 <int>, more_p_0.03 <int>,
#> #   more_p_0.04 <int>, more_p_0.05 <int>

Немного gather, separate и spread забавно, и это будет в нужном формате.

Однако, когда мыПишите функционалы тоже, используя переменную correct, она ломается, потому что correct не найден:

afun <- list(
  TP_fun = function(a) { function(p) sum(!correct & p <  a)},
  FP_fun = function(a) { function(p) sum( correct & p <  a)},
  FN_fun = function(a) { function(p) sum(!correct & p >= a)},
  TN_fun = function(a) { function(p) sum( correct & p >= a)}
) %>%
  imap(~list(f = .x, label = .y))

# all combinations of alpha and the functions
fun_list <- cross(list(alpha = alpha, f = afun)) %>% map(function(x) {
  list(
    f = x$f$f(x$alpha),
    label = paste(x$f$label, x$alpha, sep = "_")
  )
}) %>%
  set_names(., map_chr(., ~ .x$label)) %>%
  map(~ .x$f)


df %>%
  summarize_at(
    .vars = vars(pval),
    .funs = funs(!!!fun_list)
  )
#> Error in summarise_impl(.data, dots): Evaluation error: object 'correct' not found.

Я пытался заменить correct в функционалах на .$correct, но это не решаетэта проблема.Как лучше всего ссылаться на дополнительные переменные внутри функционала?

В качестве отступления - я чувствую, что должно быть более простое решение этой проблемы.Если я слишком усложняю простую проблему, пожалуйста, не стесняйтесь

Создано в 2019-01-30 пакетом Представить (v0.2.1)

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...