File: test-marginaleffects.R

package info (click to toggle)
r-cran-parameters 0.24.2-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 3,852 kB
  • sloc: sh: 16; makefile: 2
file content (130 lines) | stat: -rw-r--r-- 4,165 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
skip_if_not_installed("marginaleffects", minimum_version = "0.25.0")
skip_if_not_installed("rstanarm")

test_that("marginaleffects()", {
  # Frequentist
  x <- lm(Sepal.Width ~ Species * Petal.Length, data = iris)
  model <- marginaleffects::avg_slopes(x, newdata = insight::get_datagrid(x, by = "Species"), variables = "Petal.Length")
  out <- parameters(model)
  expect_identical(nrow(out), 1L)
  cols <- c("Parameter", "Comparison", "Coefficient", "SE", "Statistic", "p", "S", "CI", "CI_low", "CI_high")
  expect_true(all(cols %in% colnames(out)))
  out <- model_parameters(model, exponentiate = TRUE)
  expect_equal(out$Coefficient, 1.394, tolerance = 1e-3)

  # Bayesian
  x <- suppressWarnings(
    rstanarm::stan_glm(
      Sepal.Width ~ Species * Petal.Length,
      data = iris,
      refresh = 0,
      iter = 100,
      chains = 1
    )
  )
  model <- marginaleffects::avg_slopes(x, newdata = insight::get_datagrid(x, by = "Species"), variables = "Petal.Length")
  expect_identical(nrow(parameters(model)), 1L)
})


test_that("predictions()", {
  x <- lm(Sepal.Width ~ Species * Petal.Length, data = iris)
  p <- marginaleffects::avg_predictions(x, by = "Species")
  out <- parameters(p)
  expect_identical(nrow(out), 3L)
  expect_named(out, c(
    "Predicted", "SE", "CI", "CI_low", "CI_high", "S", "Statistic",
    "p", "Species"
  ))
  out <- parameters(p, exponentiate = TRUE)
  expect_equal(out$Predicted, c(30.81495, 15.95863, 19.57004), tolerance = 1e-4)
})


test_that("comparisons()", {
  data(iris)
  # Frequentist
  x <- lm(Sepal.Width ~ Species * Petal.Length, data = iris)
  m <- marginaleffects::avg_comparisons(x, newdata = insight::get_datagrid(x, by = "Species"), variables = "Petal.Length")
  expect_identical(nrow(parameters(m)), 1L)
  out <- parameters(m, exponentiate = TRUE)
  expect_equal(out$Coefficient, 1.393999, tolerance = 1e-4)

  # Bayesian
  x <- suppressWarnings(
    rstanarm::stan_glm(
      Sepal.Width ~ Species * Petal.Length,
      data = iris,
      refresh = 0,
      iter = 100,
      chains = 1
    )
  )
  m <- marginaleffects::avg_slopes(
    x,
    newdata = insight::get_datagrid(x, by = "Species"),
    variables = "Petal.Length"
  )
  expect_identical(nrow(parameters(m)), 1L)
})


test_that("hypotheses()", {
  data(mtcars)
  x <- lm(mpg ~ hp + wt, data = mtcars)
  m <- marginaleffects::hypotheses(x, "hp = wt")
  expect_identical(nrow(parameters(m)), 1L)
})


test_that("multiple contrasts: Issue #779", {
  skip_if(getRversion() < "4.0.0")
  data(mtcars)
  mod <- lm(mpg ~ as.factor(gear) * as.factor(cyl), data = mtcars)
  cmp <- suppressWarnings(marginaleffects::comparisons(
    mod,
    variables = c("gear", "cyl"),
    newdata = insight::get_datagrid(mod, by = c("gear", "cyl")),
    cross = TRUE
  ))
  cmp <- suppressWarnings(parameters(cmp))
  expect_true("Comparison: gear" %in% colnames(cmp))
  expect_true("Comparison: cyl" %in% colnames(cmp))
})


test_that("model_parameters defaults to FALSE: Issue #916", {
  data(mtcars)
  mod <- lm(mpg ~ wt, data = mtcars)
  pred <- marginaleffects::predictions(mod, newdata = marginaleffects::datagrid(wt = c(1, 2)))
  out1 <- model_parameters(pred)
  out2 <- model_parameters(pred, exponentiate = FALSE)
  expect_equal(out1$Predicted, out2$Predicted, tolerance = 1e-4)
})


test_that("digits and ci_digits for marginaleffects", {
  data(mtcars)
  skip_if(getRversion() < "4.2.0")
  out <- lm(mpg ~ wt, data = mtcars) |>
    marginaleffects::hypotheses(hypothesis = "10*wt = 0") |>
    model_parameters(digits = 1)
  expect_snapshot(out)
})


test_that("preserve columns with same name as reserved words", {
  data(mtcars)
  skip_if(getRversion() < "4.2.0")
  skip_if_not_installed("modelbased")

  set.seed(1234)
  x <- rnorm(200)
  z <- rnorm(200)
  # quadratic relationship
  y <- 2 * x + x^2 + 4 * z + rnorm(200)
  d <- data.frame(x, y, z)
  model <- lm(y ~ x + z, data = d)
  pred <- modelbased::estimate_means(model, c("x", "z"))
  expect_named(pred, c("x", "z", "Mean", "SE", "CI_low", "CI_high", "t", "df"))
})