Hacktoberfest 2026: le issue che i maintainer hanno segnato per ottobre, aperte e adatte ai principianti. Sfoglia le issue Hacktoberfest

`makepredictcall` for `degroup()`

Aperta
  • Qualcosa non va?
#643 2 commenti 0 reazioni 0 assegnatari Vedi su GitHub

Nessuno ha ancora preso questa issue.

Valutazione

Difficoltà
3/5
Tempo stimato
1-2 giorni
Idoneità per principianti
38/100
Tipo di issue
Funzionalità
Chiarezza
Abbastanza chiara
Stato di attività
Ferma
Stack tecnologico
r
Ambito
data

Direzione di ricerca

Parti dai punti di ingresso degroup() e demean() ed esamina come gli oggetti dw_degroup restituiti vengono usati nelle formule. Implementa il comportamento makepredictcall.dw_degroup dell’issue in modo che la valutazione delle formule preservi le medie memorizzate, quindi verifica gli esempi forniti con lm(), predict() e marginaleffects::avg_slopes().

Scritto dal modello di indicizzazione a partire dal testo della issue.

Descrizione

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
#>
Lingua principale
R
Stelle
238
Fork
18
Merge medio
3h 14m
PR unite (30g)
1

Preparare l'ambiente

Come iniziare

  1. Leggi tutta la issue e poi la guida ai contributi del progetto.
  2. Commenta sulla issue per dire che te ne occupi tu — evita che due persone facciano lo stesso lavoro.
  3. Fai un fork del repository e lavora su un branch.
  4. Apri una pull request che faccia riferimento al numero della issue.

Altre issue di easystats/datawizard

Tutte le issue di easystats/datawizard

Issue simili

Altre issue su R

Ricevi le nuove issue nella tua casella

Un breve riepilogo di issue GitHub adatte ai principianti.