代码之家 › 专栏 › 技术社区 › Melissa Key

在R中使用从本地环境获取变量的函数(词汇范围问题)

rlang purrr dplyr r

Melissa Key · 技术社区 · 6 年前

我正在使用一些模拟来研究分类类型问题,我想使用不同的阈值来计算真阳性、假阳性等的数量。例如,请考虑以下示例:

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

对于固定的截止时间,任务是微不足道的(请忽略任务的方向,它们对于我正在处理的实际任务是正确的,但我确实认识到它们可能出现在这里的后面)。这正是我想要达到的目标,但不止一个目标:

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 它也会破裂因为 对的

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

顺便说一下,我觉得这个问题应该有一个更简单的解决方案。如果我把一个简单的问题复杂化了,请随意

^{于2019-01-30由

reprex package

(第5.2.1节)}

0 回复 | 直到 6 年前