【问题标题】:How to plot predicted margins when they are specified with 'at'?当用“at”指定预测边距时,如何绘制预测边距?
【发布时间】:2023-03-30 19:24:02
【问题描述】:

我们可以使用margins::margins() 获得线性模型的边际效应,并且可以使用选项variables 选择感兴趣的变量。

fit <- lm(mpg ~ factor(vs) + gear:factor(vs) + qsec, mtcars)

library(margins)
marg1 <- margins(fit, variables="vs")

> summary(marg1)
 factor    AME     SE      z      p   lower   upper
    vs1 4.8023 2.6769 1.7940 0.0728 -0.4443 10.0490

包有一个实现的方法plot.margins,所以我们可以绘制边际效应

plot(marg1)

at 允许我们指定计算边际效应的值:

marg2 <- margins(fit, variables="vs", at=list(gear=c(3, 4, 5)))

> summary(marg2)
 factor   gear    AME     SE      z      p   lower   upper
    vs1 3.0000 2.8606 3.3642 0.8503 0.3952 -3.7332  9.4544
    vs1 4.0000 5.6849 2.6713 2.1282 0.0333  0.4493 10.9206
    vs1 5.0000 8.5093 3.8523 2.2089 0.0272  0.9588 16.0597

但是,尝试绘制这些指定的边距会产生错误:

plot(marg2)
Error in `[.data.frame`(summ, , names(attributes(x)[["at"]]), drop = FALSE) : 
  undefined columns selected

由于margins 包声称是“Stata 'margins' 命令的 R 端口”,我希望情节类似于 Stata 给出的情节:

那么,我们如何绘制使用at 指定的预测边距?

编辑:

请注意,这并不是一个普通的交互图,因为

with(mtcars[mtcars$gear %in% c(3, 4, 5), ], 
     interaction.plot(gear, vs, mpg, pch=rep(1, 2), type="b"))

给出不同的输出:

【问题讨论】:

  • 这就是我所说的“交互图”。您是否使用该搜索词寻找答案?
  • @42- 感谢您的建议,但这不是一个纯粹的互动情节。你可能想看看我的编辑。
  • 我不同意。您使用interaction.plot 生成的交互图具有分类交叉分类参数,而您想要的交互图具有分类交叉线性参数。它们都是具有交互作用的模型的展示。

标签: r plot regression marginal-effects


【解决方案1】:

错误来自plot"margins"plot.margins 的对象的方法中的一个错误。
这是试图纠正它。更改在函数体中,只需执行此操作或将其保存在文件中"plotmargins.R" 然后source("plotmargins.R")

plot.margins <-
function (x, pos = seq_along(marginal_effects(x, with_at = FALSE)), 
    which = colnames(marginal_effects(x, with_at = FALSE)), labels = gsub("^dydx_", 
        "", which), horizontal = FALSE, xlab = "", ylab = "Average Marginal Effect", 
    level = 0.95, pch = 21, points.col = "black", points.bg = "black", 
    las = 1, cex = 1, lwd = 2, zeroline = TRUE, zero.col = "gray", 
    ...) 
{
    pars <- list(...)
    summ <- summary(x, level = level, by_factor = TRUE)
    MEs <- summ[, "AME", drop = TRUE]
    lower <- summ[, ncol(summ) - 1L]
    upper <- summ[, ncol(summ)]
    r <- max(upper) - min(lower)

    #--- changes start here
    nms <- intersect(names(summ), names(attributes(x)[["at"]]))
    at_levels <- unique(summ[, nms, drop = FALSE])
    #--- changes end here

    n_at_levels <- nrow(at_levels)
    if (n_at_levels > 1) {
        pos2 <- rep(pos, each = n_at_levels)
        pos2 <- pos2 + seq(from = -0.2, to = 0.2, length.out = n_at_levels)
    }
    else {
        pos2 <- pos
    }
    if (isTRUE(horizontal)) {
        xlim <- if ("xlim" %in% names(pars)) 
            xlim
        else c(min(lower) - 0.04 * r, max(upper) + 0.04 * r)
        ylim <- if ("ylim" %in% names(pars)) 
            xlim
        else c(min(pos2) - (0.04 * min(pos2)), max(pos2) + (0.04 * 
            max(pos2)))
    }
    else {
        xlim <- if ("xlim" %in% names(pars)) 
            xlim
        else c(min(pos2) - (0.04 * min(pos2)), max(pos2) + (0.04 * 
            max(pos2)))
        ylim <- if ("ylim" %in% names(pars)) 
            xlim
        else c(min(lower) - 0.04 * r, max(upper) + 0.04 * r)
    }
    if (isTRUE(horizontal)) {
        plot(NA, xlim = xlim, ylim = ylim, yaxt = "n", xlab = ylab, 
            ylab = xlab, las = las, ...)
        if (isTRUE(zeroline)) {
            abline(v = 0, col = zero.col)
        }
        points(MEs, pos2, col = points.col, bg = points.bg, pch = pch)
        axis(2, at = pos, labels = as.character(labels), las = las)
        mapply(function(pos, upper, lower, lwd) {
            segments(upper, pos, lower, pos, col = points.col, 
                lwd = lwd)
        }, pos2, upper, lower, seq(max(lwd), 0.25, length.out = length(MEs)))
    }
    else {
        plot(NA, xlim = xlim, ylim = ylim, xaxt = "n", xlab = xlab, 
            ylab = ylab, las = las, ...)
        if (isTRUE(zeroline)) {
            abline(h = 0, col = zero.col)
        }
        points(pos2, MEs, col = points.col, bg = points.bg, pch = pch)
        axis(1, at = pos, labels = as.character(labels), las = las)
        mapply(function(pos, upper, lower, lwd) {
            segments(pos, upper, pos, lower, col = points.col, 
                lwd = lwd)
        }, pos2, upper, lower, seq(max(lwd), 0.25, length.out = length(MEs)))
    }
    invisible(x)
}

现在你的代码和图表。

source("plotmargins.R")

marg2 <- margins(fit, variables = "vs", 
                 at = list(gear = c(3, 4, 5)))

plot(marg2)

【讨论】:

  • +1太好了,它正在绘制。但是,结果与我的预期不同:vs 尚未拆分。也许margins() 函数没有这样做,或者我编码错误。你知道如何解决这个问题吗?
  • @jay.sf 不,这是我第一次使用这个包。我的回答是基于代码检查,而不是对包的经验。
猜你喜欢
  • 1970-01-01
  • 2018-01-07
  • 1970-01-01
  • 2017-11-01
  • 2011-11-13
  • 1970-01-01
  • 2016-10-24
  • 2016-04-08
  • 1970-01-01
相关资源
最近更新 更多