Question

此问题与Pipe '.' dot causes trouble in glm call有关。

purrr：map非常适合进行亚组分析和/或模型比较。但是，在使用glm时，通话陷入混乱并引起了问题，例如在计算伪R2时。原因是update与丑陋的call不兼容，因此pscl::pR2无法计算基本模型的对数似然。

pacman::p_load(tidyverse)

#sample data
pacman::p_load(ISLR)
mydata = ISLR::Default

#nest data, students and non-students
Default_nested = Default %>% group_by(student) %>% nest 

#fit glms
formul= default ~income+balance

glms = Default_nested %>% 
  mutate(model=map(data,glm,formula=formul,family='binomial')) 

#pscl::pR2 throwing error
pacman::p_load(pscl)
glms %>% mutate(pr2=map(model,pR2))

现在，我们可以看一下第一个子模型。即使公式包含正确的公式，调用也看起来很奇怪（formula = .. 1）。

> glms$model[[1]]$call
.f(formula = ..1, family = "binomial", data = .x[[i]])
> glms$model[[1]]$formula
default ~ income + balance
> glms$model[[1]]$data
# A tibble: 7,056 x 3
   default balance income
   <fct>     <dbl>  <dbl>
 1 No         730. 44362.

当小标题中有许多glm对象（在此示例中为2个以上）时，使用pscl :: pR2的最干净方法是什么？

编辑：

解决方案策略概述：

（A） “修复” glm对象，以便可以将update应用于它：

glms %>% mutate(model = map(model,function(x){x$call = call2("glm",formula=x$formula,data=quote(Default),family='binomial');x})) %>%
  mutate(pr2=map(model,pR2)) %>% unnest(pr2)

此“运行”，但是计算的R2关闭。因此，这种解决方案策略可能是死路一条。

（B）按照Artem的建议为glm编写包装器。这应该工作正常。缺点：通话看起来很丑。

我扩展了Artem提出的解决方案以创建glm3。

glm3 <- function(formula,data,family) {  
  eval(rlang::expr( glm(!!rlang::enexpr(data),
                        formula=!!formula,
                        family=!!family ) ))}

glms3 <- Default_nested %>% mutate( model=map(data,glm3,formula=formul,family='binomial'),pr2=map(model,pR2) )
glms3 %>% unnest(pr2)

（C）在这种特殊情况下（伪R2），只需编写一个更好的 pseudo-r2函数。由于它可能是在purrr :: map中不起作用的唯一主要统计数据，因此这实际上是有道理的。我整理了psr2glm函数。

psr2glm=function(glmobj){

  L.base=
    logLik(
      glm(formula = reformulate('1',gsub( " .*$", "", deparse(glmobj$formula) )),
          data=glmobj$data,
          family = glmobj$family))

  n=length(glmobj$residuals)

  L.full=logLik(glmobj)
  D.full <- -2 * L.full
  D.base <- -2 * L.base
  G2 <- -2 * (L.base - L.full)

  return(data.frame(McFadden = 1-L.full/L.base, 
                    CoxSnell = 1 - exp(-G2/n),
                    Nagelkerke = (1 - exp((D.full - D.base)/n))/(1 - exp(-D.base/n))))

}

有效：

glms = Default_nested %>% 
  mutate(model=map(data,glm,formula=formul,family='binomial')) 
glms %>% mutate(pr2=map(model,psr2glm)) %>% unnest(pr2)

我考虑提议对DescTools ::: PseudoR2进行更改，但是，我首先需要检查解决方案是否通用。

此想法的关键是跳过update，而是直接调用glm。所有必需的信息都在glm对象中，甚至在purrr :: map中也是如此。使用psr2glm有不错的副作用：嵌套的输出看起来不错。

（D）更改glm或update。鉴于glm对象实际上包含所有必要的信息，因此可以将观察到的行为视为错误。因此，应将其固定在基数R中。

Answer 1

一种方法是为glm()定义一个包装器，该包装器通过手动构造该表达式然后对其求值来将数据直接放入调用中：

glm2 <- function(.df, ...) {
  eval(rlang::expr(glm(!!rlang::enexpr(.df),!!!list(...)))) }

glms <- Default_nested %>%
    mutate( model = map(data,glm2,formula=formul,family="binomial"),
            pr2   = map(model,pscl::pR2) )
# # A tibble: 2 x 4
#   student data                 model  pr2      
#   <fct>   <list>               <list> <list>   
# 1 No      <tibble [7,056 × 3]> <glm>  <dbl [6]>
# 2 Yes     <tibble [2,944 × 3]> <glm>  <dbl [6]>

验证：

## Perform the computation by hand and ensure that it's identical to glms$pr2
glm(Default_nested$data[[1]], formula=default~income+balance, family="binomial") %>%
  pscl::pR2() %>% identical( glms$pr2[[1]] )     # TRUE
glm(Default_nested$data[[2]], formula=default~income+balance, family="binomial") %>%
  pscl::pR2() %>% identical( glms$pr2[[2]] )     # TRUE

purrr：map和glm-通话问题

1 个答案: