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