如何编写一个包含 R 包中函数的简单函数?

How do I write a simple function that incorporates a function from an R package?

当我指定所有内容时,它运行良好,但只是试图用“分数”和“结果”来概括它,但它失败了(见结尾)。知道怎么做吗? (我有索引的东西,因为我想 bootstrap 稍后)

library(PRROC)
df <- iris %>% filter(Species != "virginica") %>% mutate(outcome_versi = ifelse(Species == "versicolor", 1, 0)) %>% select(Sepal.Length, outcome_versi)

#Iris single AUC
fc <- function(data, indices){
  d <- data[indices,]
  versi.y <- d %>% filter(outcome_versi == 1) %>% select(Sepal.Length)
  versi.n <- d %>% filter(outcome_versi == 0)%>% select(Sepal.Length)
  prroc.sepal.length <-pr.curve(scores.class0 = versi.y$Sepal.Length, scores.class1 = versi.n$Sepal.Length, curve=T)
  return(prroc.sepal.length$auc.integral)
}

fc(df)
#AUC = 0.94

#Iris single AUC - functionalized
fcf <- function(score, outcome, data, indices){
  d <- data[indices,]
  test.pos <- d %>% filter(outcome==1) %>% select(score)
  test.neg <- d %>% filter(outcome==0) %>% select(score)
  prroc.test <-pr.curve(scores.class0 = test.pos$score, scores.class1 = test.neg$score, curve=T)
  return(prroc.test$auc.integral)
}

fcf(data=df, score=Sepal.Length, outcome = outcome_versi)
#Error: 'outcome' not found```

这个有用吗?

fcf <- function(score, outcome, data, indices){
  d <- data[indices,]
  test.pos <- d %>% filter(outcome==1) %>% select(all_of(score))
  test.neg <- d %>% filter(outcome==0) %>% select(all_of(score))
  prroc.test <-pr.curve(scores.class0 = test.pos$score, scores.class1 = test.neg$score, curve=T)
  return(prroc.test$auc.integral)
}

fcf(data=df, score='Sepal.Length', outcome = 'outcome_versi')

我没有需要的包来测试。但我认为这是因为您在 df 中请求了一个列,但它本身并不是一个变量。

N.B。如果你有旧版本的 dplyr 你可能需要使用 rlang quasiquotation

正如我昨天提到的,这是一个标准的 NSE 问题,在 tidyverse 中编程时 [几乎] 总是会遇到。问题是因为 tidyverse 允许你写,例如,

iris %>% filter(Sepal.Length < 6)

在所有其他条件相同的情况下,在调用函数时,对象 Sepal.Length 不存在,但不会抛出任何错误并且代码“按预期运行”。

根据您的情况,我是这样处理的。请注意,我已经删除了函数的 condition 参数,因为我觉得这更自然地通过在管道中早些时候调用 filter 来处理,并且我已经移动了 data/d 成为函数的第一个参数,以便它更自然地适合管道。

此外,我没有 PRROC 包,所以在函数中取消了对它的调用,并相应地替换了原来的 return 值。只需进行明显的更改即可获得所需的功能。 NSE问题的解决方案不依赖于访问PRROC.

library(magrittr)
library(dplyr)

fcf <- function(d, score=Sepal.Length, outcome = outcome_versi){
  qScore <- enquo(score)
  qOutcome <- enquo(outcome)

  test.pos <- d %>% filter(!! qOutcome == 1) %>% select(!! qScore)
  test.neg <- d %>% filter(!! qOutcome == 0) %>% select(!! qScore)
  # prroc.test <-pr.curve(scores.class0 = test.pos$score, scores.class1 = test.neg$score, curve=T)
  # return(prroc.test$auc.integral)
  return(list("pos"=test.pos, "neg"=test.neg))
}

# as_tibble simply to improve formatting
as_tibble(iris) %>% 
  mutate(outcome_versi = ifelse(Species == "versicolor", 1, 0)) %>% 
  fcf()

$pos
# A tibble: 50 × 1
   Sepal.Length
          <dbl>
 1          7  
 2          6.4
 3          6.9
 4          5.5
 5          6.5
 6          5.7
 7          6.3
 8          4.9
 9          6.6
10          5.2
# … with 40 more rows

$neg
# A tibble: 100 × 1
   Sepal.Length
          <dbl>
 1          5.1
 2          4.9
 3          4.7
 4          4.6
 5          5  
 6          5.4
 7          4.6
 8          5  
 9          4.4
10          4.9
# … with 90 more rows

同样,

set.seed(123)
as_tibble(iris) %>% 
   mutate(
    outcome_versi = ifelse(Species == "versicolor", 1, 0),
    RandomOutcome=runif(nrow(.)) > 0.5
  ) %>% 
  filter(Sepal.Length < 6) %>% 
  fcf(score=Petal.Width, outcome=RandomOutcome)

$pos
# A tibble: 40 × 1
   Petal.Width
         <dbl>
 1         0.2
 2         0.2
 3         0.2
 4         0.3
 5         0.2
 6         0.2
 7         0.2
 8         0.1
 9         0.1
10         0.4
# … with 30 more rows

$neg
# A tibble: 43 × 1
   Petal.Width
         <dbl>
 1         0.2
 2         0.2
 3         0.4
 4         0.1
 5         0.2
 6         0.2
 7         0.4
 8         0.3
 9         0.3
10         0.2
# … with 33 more rows

最后,如果你想在赋值的左边手边使用一个enquoted变量,那么你需要使用:==.