`makepredictcall` for `degroup()`

未关闭
  • 哪里不对？
#643 2 条评论 0 个 reaction 已指派 0 人 在 GitHub 查看

维护者通常 4 天内回复

还没有人认领这个 Issue。

评估

难度
3/5
预计耗时
1-2 天
新手友好度
38/100
Issue 类型
功能
描述清晰度
基本清楚
活跃度
停滞
技术栈
r
领域
data

调研方向

从 degroup() 和 demean() 入口点开始，检查它们返回的 dw_degroup 对象如何在公式中使用。实现 issue 的 makepredictcall.dw_degroup 行为，使公式求值保留存储的均值，然后验证提供的 lm()、predict() 和 marginaleffects::avg_slopes() 示例。

由索引模型根据 Issue 内容生成。

描述

Feature idea :fire:

This will allow using demean() or degroup() inside a formula, which can then play nice with brms or marginaleffects etc...

Code 
degroup.numeric <- function(x,
                            ...,
                            means = NULL,
                            center = "mean",
                            suffix_demean = "_within",
                            suffix_groupmean = "_between") {
  
  
  dat <- data.frame(x, ...)
  x_name <- insight::safe_deparse(substitute(x))
  colnames(dat)[1] <- x_name
  
  if (is.null(means)) {
    group_cols <- colnames(dat)[-1]
    
    dat_degrouped <- degroup(dat,
                             select = colnames(dat)[1],
                             by = group_cols,
                             center = center,
                             suffix_demean = suffix_demean,
                             suffix_groupmean = suffix_groupmean, 
                             append = TRUE)
    cols <- colnames(dat_degrouped)
    between_cols <- cols[grepl(suffix_groupmean, cols)]
    within_cols <- cols[grepl(suffix_demean, cols)]
    
    table_cols <- c(group_cols, between_cols)
    means <- unique(dat_degrouped[table_cols])
    
    out <- dat_degrouped[c(between_cols, within_cols)]
  } else {
    dat_groupmeans <- data_join(dat, means)
    
    cols <- colnames(dat_groupmeans)
    between_cols <- cols[grepl(suffix_groupmean, cols)]
    
    # # Replace missing with grandmeans?
    # if (anyNA(dat_groupmeans[between_cols])) {
    #   grand_means <- lapply(means[between_cols], mean, na.rm = TRUE)
    #   
    #   for (nm in names(grand_means)) {
    #     dat_groupmeans[is.na(dat_groupmeans[[nm]]),nm] <- grand_means[[nm]]
    #   }
    # }
    
    sum_group_means <- Reduce("+", dat_groupmeans[between_cols])
    
    dat_groupmeans$x_within <- dat_groupmeans[[x_name]] - sum_group_means
    out <- dat_groupmeans[c(between_cols, "x_within")]
    colnames(out)[ncol(out)] <- paste0(x_name, suffix_demean)
    out <- as.matrix(out)
  }
  
  out <- as.matrix(out)
  rownames(out) <- NULL
  attr(out, "means") <- means
  class(out) <- c("dw_degroup", class(out))
  out
}

demean.numeric <- function(x,
                           ...,
                           means = NULL,
                           center = "mean",
                           suffix_demean = "_within",
                           suffix_groupmean = "_between") {
  cl <- match.call()
  cl[[1]] <- quote(datawizard::degroup)
  cl$center <- "mean"
  eval.parent(cl)
}


dat <- data.frame(
  a = c(1, 2, 3, 4, 1, 2, 3, 4),
  x = c(4, 3, 3, 4, 1, 2, 1, 2),
  y = c(1, 2, 1, 2, 4, 3, 2, 1),
  ID = c(1, 2, 3, 1, 2, 3, 1, 2)
)


makepredictcall.dw_degroup <- function(var, call) {
  call$means <- attr(var, "means")
  call
}

Example:

data("egsingle", package = "mlmRev")

mod <- lm(math ~ degroup(grade, childid, schoolid), 
          data = egsingle)

parameters::model_parameters(mod)
#> Parameter                                               | Coefficient |   SE |         95% CI | t(7226) |      p
#> ----------------------------------------------------------------------------------------------------------------
#> (Intercept)                                             |       -3.11 | 0.09 | [-3.29, -2.94] |  -34.60 | < .001
#> degroup(grade, childid, schoolid)grade childid between  |        1.00 | 0.02 | [ 0.95,  1.04] |   42.55 | < .001
#> degroup(grade, childid, schoolid)grade schoolid between |        1.19 | 0.06 | [ 1.08,  1.30] |   21.50 | < .001
#> degroup(grade, childid, schoolid)grade within           |        0.77 | 0.01 | [ 0.75,  0.78] |   76.16 | < .001
#> Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed using a Wald
#>   t-distribution approximation.

predict(
  mod, 
  newdata = data.frame(grade = 3, schoolid = 2020, childid = 273026452)
)
#>         1 
#> 0.6773423 

marginaleffects::avg_slopes(mod, variables = "grade")
#> 
#>  Estimate Std. Error    z Pr(>|z|)   S 2.5 % 97.5 %
#>     0.765       0.01 76.2   <0.001 Inf 0.746  0.785
#> 
#> Term: grade
#> Type: response
#> Comparison: dY/dX
#>
主要语言
R
星标
238
派生
19
平均合并
4 天 14 小时
30 天内合并 PR
17

环境准备

  • 没有 Dockerfile 或 Docker Compose 文件
  • 没有 Pull Request 模板
  • 阅读贡献指南

从这里开始

  1. 先读完整个 Issue，再读项目的贡献指南。
  2. 在 Issue 下留言说明你要接手 —— 这能避免两个人做同样的事。
  3. Fork 仓库，在一个分支上完成修改。
  4. 提交 Pull Request，并在描述里引用这个 Issue 编号。

easystats/datawizard 的其他 Issue

查看 easystats/datawizard 的全部 Issue

相似的 Issue

更多 R Issue

把新 issue 发到你的邮箱

精选适合新手参与的 GitHub issue 摘要。