r - 想知道如何输出我在经济学家杂志上看到的图表

Question

我在最近的一位经济学家身上看到了这一点，我想知道是否有人有代码可以帮助使用 ggplot 复制它。 Economist Chart


谢谢!

Answer 1

我只使用基本绘图功能玩了一点。这是结果:



这是产生它的代码:

bigmacprice <- data.frame(
    country = c("Switzerland", "Brazil", "Euro area",
        "Canada", "Japan", "United States",
        "Britain", "Singapore", "South Korea",
        "South Africa", "Mexico", "Thailand",
        "Russia", "Malaysia", "China"),
    price = c(6.78, 5.26, 4.79, 4.18, 3.91, 3.71,
              3.63, 3.46, 3.03, 2.79, 2.58, 2.44,
              2.39, 2.25, 2.18)
)


plotbigmac <- function(mac, base = "United States", xlim = c(-40, 100)) {
    mac <- mac[order(mac$price),]
    base = which(mac$country == base)
    height <- (mac$price / mac[base, "price"] - 1) * 100
    par(bg = "#d0e0e7", col.main = "#262324", col.axis = "#393E46",
        mar = c(8, 8, 6, 6), las = 1)
    barplot(height, width = .1, space = .4,
        names.arg = mac$country, #cex.names = .8,
        col = "#01516c", border = "#7199a8", # border = "#577784",
        horiz = TRUE, xlim = c(-40, 100), axes = FALSE)
    axis(3, lty = 0)
    title(main = "Bunfight\nBig Mac index", col = "#393E46")

    abline(v = seq(-100, 100, 10), col = "white", lwd = 2)
    abline(v = 0, col = "#c8454e", lwd = 2)
    par(xpd = TRUE)
    for (i in 1:nrow(mac)) {
        rect(105, (i - 1) / 7, 118, i / 7 - 0.05,
        col = "white", border = "#7199a8")
        text(112, (i - 1) / 7 + 0.05, mac$price[i], cex = 0.8, col = "#393E46")
    }
    rect(-120, 2.5, -90, 3, col = "#c8454e", border = "#c8454e")
    text(-68, -.2, "Sources:", col = "#393E46")
    text(-64, -.3, "McDonald's;", col = "#393E46")
    text(-60, -.4, "The Economist", col = "#393E46")
}

plotbigmac(bigmacprice)

它可能不是完全匹配(例如，我不知道如何在不直接调用文本的情况下正确对齐)，如果您尝试调整它的大小，文本会跳来跳去，因此您必须进一步调整参数以适应您的需要。但它表明你可以在 R 中只使用基本的绘图功能。

编辑:正如评论的那样，白色条纹穿过横条。这是不可避免的，不能通过再次调用 barplot 来调整。因为那会重新绘制绘图区域。因此，我们必须查看 barplot 的源代码。并为此目的对其进行自定义(喜欢这在 R 中是多么容易)。但是现在我们已经超越了 R 中舒适的基础知识(即使用内置的 barplot)。这是另一个尝试:

plotBigMac <- function(mac, base = "United States") {
    old.par <- par(no.readonly = TRUE)
    on.exit(par(old.par))
    # Create data:
    mac <- mac[order(mac$price),]
    base = which(mac$country == base)
    height <- (mac$price / mac[base, "price"] - 1) * 100
    # Costume 'barplot'
    NN <- length(height)
    width <- rep(1, length.out = NN)
    delta <- width / 2
    w.r <- cumsum(width + 0.5)
    w.m <- w.r - delta
    w.l <- w.m - delta
    xlim <- c(range(-.01 * height, height)[1], 100)
    ylim <- c(min(w.l), max(w.r))
    par(bg = "#d0e0e7", col.main = "#262324", col.axis = "#393E46",
        mar = c(8, 8, 6, 6), las = 1, cex = 0.9)
    plot.new()
    plot.window(xlim, ylim)
    abline(v = seq(-100, 100, 20), col = "white", lwd = 2)
    rect(0, w.l, height, w.r, col = "#01516c", border = "#7199a8", lwd = 1)

    # Lines and axis
    abline(v = 0, col = "#c8454e", lwd = 2)
    axis(3, axTicks(3), abs(axTicks(3)), lty = 0)
    axis(2, labels = mac$country, at = w.m, lty = 0)

    # Move outside of plot area
    par(xpd = TRUE)

    # Text misc.
    text(5, (w.l[base] + w.r[base]) / 2, "nil", font = 3)
    text(8, w.r[NN] + 2.3, "+")
    text(-8, w.r[NN] + 2.3, "-")

    # Create price boxes:
    rect(105, w.l, 125, w.r,
        col = "white", border = "#7199a8", lwd = 1)
    text(115, (w.r + w.l)/2, mac$price, cex = 0.8, col = "#393E46")

}

这创造了这个: