如何使用可能与lm？

Question

考虑这个简单的例子

library(dplyr)
library(broom)

dataframe <- data_frame(id = c(1,2,3,4,5,6),
                        value = c(NA,NA,NA,NA,NA,NA))
dataframe

> dataframe
# A tibble: 6 x 2
     id value
  <dbl> <lgl>
1     1    NA
2     2    NA
3     3    NA
4     4    NA
5     5    NA
6     6    NA

我有一个函数,主要用于lm计算我的数据帧中列的平均值.

get_mean <- function(data, myvar){
  col_name <- as.character(substitute(myvar))
  fmla <- as.formula(paste(col_name, "~ 1"))
  tidy(lm(data = data, fmla, na.action = 'na.omit')) %>% pull(estimate)
}

现在

> get_mean(dataframe, id)
[1] 3.5

但由于缺少价值,

get_mean(dataframe, value)

回归可怕的

Error in lm.fit(x, y, offset = offset, singular.ok = singular.ok, ...) : 
  0 (non-NA) cases 

当所有NA情况出现时,我希望函数返回NA或我指定的任何数字.我尝试使用purrr:possibly但没有成功

get_mean <- function(data, myvar){
  col_name <- as.character(substitute(myvar))
  fmla <- as.formula(paste(col_name, "~ 1"))
  model <- purrr::possibly(lm(data = data, fmla, na.action = 'na.omit'), NA)
  if(!is.na(model)) {
  tidy(model) %>%  pull(estimate)
  }
}

get_mean(dataframe, id)

不起作用

错误:无法将列表转换为函数

我该怎么办？谢谢!!

Answer 1

您可以将整个函数包装起来possibly,因此如果整个函数在任何地方失败,您将获得NA.

get_mean <- possibly(function(data, myvar) {
     col_name <- as.character(substitute(myvar))
     fmla <- as.formula(paste(col_name, "~ 1"))
     model <- lm(data = data, fmla, na.action = 'na.omit')
     tidy(model) %>%  pull(estimate)
}, otherwise = NA)

get_mean(dataframe, id)
[1] 3.5
 get_mean(dataframe, value)
[1] NA

但是,与tryCatch此不同的是,并未将重点放在lm代码的一部分上.它正在处理整个函数,如果出于任何原因发生任何错误,将返回NA.例如,如果您在运行之前忘记加载扫帚包,即使模型正常工作get_mean也会NA回来,因为R无法找到tidy.

将quiet参数设置为FALSE将允许打印错误消息,这可以帮助您减轻错误,如上面概述的错误.

您还可以possibly在文档示例中使用safely,使possibly特定功能lm可供使用.然后你可以使用一个if else语句来tidy返回或返回NA.

get_mean <- function(data, myvar) {
     col_name <- as.character(substitute(myvar))
     fmla <- as.formula(paste(col_name, "~ 1"))
     poss_lm <- possibly(lm, otherwise = NA)
     model <- poss_lm(data = data, fmla, na.action = 'na.omit')
     if( !is.na(model[1]) ) {
          tidy(model) %>%  pull(estimate)
     }
     else {
          model
     }
}