如何使用可能与lm?

时间:2017-08-31 18:10:24

标签: r dplyr purrr

考虑这个简单的例子

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)

不起作用

  

错误:无法将列表转换为功能

我该怎么办? 谢谢!

2 个答案:

答案 0 :(得分:5)

你可以将整个函数包装在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的{​​{1}}文档示例中的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
     }
}

答案 1 :(得分:3)

看起来普通的tryCatch()可以解决这个问题

get_mean <- function(data, myvar){
  col_name <- as.character(substitute(myvar))
  fmla <- as.formula(paste(col_name, "~ 1"))
  tryCatch(lm(data = data, fmla, na.action = 'na.omit') %>% tidy() %>%  pull(estimate),
                    error=function(e) NA)
}
get_mean(dataframe, id)
# [1] 3.5
get_mean(dataframe, value)
# [1] NA