issue #1313 : avg_comparisons(by=data.frame()) with bad data.table in… (

#1314)

* issue #1313 : avg_comparisons(by=data.frame()) with bad data.table indexing

* bump

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: marginaleffects
 Title: Predictions, Comparisons, Slopes, Marginal Means, and Hypothesis Tests
-Version: 0.24.0.7
+Version: 0.24.0.8
 Authors@R:
     c(person(given = "Vincent",
              family = "Arel-Bundock",

NEWS.md

@@ -22,6 +22,7 @@ Bugs:
 * Reinstate some attributes lost with `marginaleffects_lean` but necessary for printing.
 * Encoding issue in bayesian models with `by`. Thanks to @Koalha for report #1290.
 * Retain necessary attribute information to ensure that "lean" return objects still print correctly #1295.
+* Indexing problem with `avg_comparisons(by=data.frame())` and `avg_slopes(by=data.frame())`. Thanks to @andymilne for report #1313.
 
 ## 0.24.0
 

R/get_contrasts.R

@@ -374,7 +374,7 @@ get_contrasts <- function(model,
         draws <- draws[idx_na, , drop = FALSE]
 
         if (isTRUE(checkmate::check_character(by, min.len = 1))) {
-            by_idx <- subset(out, select = intersect(by, colnames(out)))
+            by_idx <- out[, ..by]
             by_idx <- do.call(paste, c(by_idx, sep = "|"))
         } else {
             by_idx <- out$term

inst/tinytest/test-pkg-brms.R

@@ -686,6 +686,50 @@ cmp <- avg_comparisons(brms_issue1006, variables = list(chl = 1, age = 1))
 expect_inherits(cmp, "comparisons")
 
 
+# Issue #1313: data.table indexing in avg_comparisons()
+set.seed(48103)
+Cndtn <- factor(c("PC", "QR", "TK", "NG"))
+TstTm <- c(0, 1)
+data <- expand.grid(Cndtn = Cndtn, TstTm = TstTm)
+data <- do.call(rbind, replicate(50, data, simplify = FALSE))
+Age <- rnorm(200, 0, 2)
+data$Age <- Age[rep(seq_len(200), each = 2)]
+data$Y <- rnorm(400, 0, 0.5) + 0.3 * (rnorm(400, 0, 0.2) + as.numeric(data$TstTm) - 1) + 0.4 * (rnorm(400, 0, 0.2) + data$Age) + 0.2 * ((rnorm(400, 0, 0.2) + as.numeric(data$TstTm) - 1)) * (rnorm(400, 0, 0.2) + as.numeric(data$Cndtn) / 10)
+mdl <- brm(Y ~ TstTm + (TstTm:Cndtn) * Age, data = data)
+
+by <- data.frame(
+  Cndtn = c("PC", "PC", "QR", "QR", "TK", "TK", "NG", "NG"),
+  TstTm = c("0", "1", "0", "1", "0", "1", "0", "1"),
+  by = c("PC0", "PC1", "QR0", "QR1", "LG0", "LG1", "LG0", "LG1")
+)
+cmp1 <- avg_comparisons(
+  mdl,
+  datagrid(Cndtn = c("PC", "QR", "TK", "NG"), grid_type = "counterfactual"),
+  variables = "Age",
+  by = by
+)
+cmp2 <- avg_comparisons(
+  mdl,
+  datagrid(Cndtn = c("PC", "QR", "TK", "NG"), grid_type = "counterfactual"),
+  variables = "Age",
+  by = c("Cndtn", "TstTm")
+)
+expect_equivalent(
+  subset(cmp1, by == "PC1")$estimate,
+  subset(cmp2, Cndtn == "PC" & TstTm == 1)$estimate
+)
+expect_equivalent(
+  subset(cmp1, by == "PC0")$estimate,
+  subset(cmp2, Cndtn == "PC" & TstTm == 0)$estimate
+)
+expect_equivalent(
+  subset(cmp1, by == "LG0")$estimate,
+  subset(cmp2, Cndtn == "NG" & TstTm == 0)$estimate
+)
+
+
+
+
 
 source("helpers.R")
 rm(list = ls())