在R中使用具有从局部环境获得的变量的函数(词汇范围问题)

时间:2019-01-31 03:16:33

标签: r dplyr purrr rlang

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

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>

有些gatherseparatespread很有趣,并且将采用所需的格式。

但是,当我们也使用变量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,但这不能解决问题。从功能中引用附加变量的最佳方法是什么?

顺便说一句-我觉得应该有一个更简单的方法来解决这个问题。如果我使一个简单的问题过于复杂,请随时

reprex package(v0.2.1)于2019-01-30创建

0 个答案:

没有答案