在基础R中使用不同颜色的堆积条形图

Question

我正在尝试创建一个具有子图和堆叠条形图的图形。我希望每个条形图在x轴上的类别中逐渐改变颜色。我还希望每个条形图的堆叠部分比底部部分稍微浅一些。这类似于this question，但我想要跨条形图渐变的颜色（而不是在条形图内）。它也类似于this one，因为条形图的底部部分比堆叠部分暗，但我想知道是否有一种方法可以在基本R中实现，而不使用ggplot。

最后，我想将一个公共图例放在整个图的中间右侧，但我无法将其从bottomright区域移动。我参考了this，但它没有起作用。

以下是我的数据和代码。

color <- c('W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 
'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 
'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl')
mass <- c(10, 14, 20, 15, 16, 13, 11, 15, 10, 14, 23, 18, 12, 22, 20, 13, 14, 17, 20, 22, 24, 17, 23, 18, 14, 15, 16, 19, 17, 15, 15, 21, 22, 18,
15, 21, 19, 23, 14, 18, 15, 23, 10, 16, 22, 10, 20, 18, 15, 12, 16, 13, 13, 15, 10, 14, 23, 18, 18, 22, 20, 13, 24, 19, 18, 24, 20, 22, 17, 19, 24, 21)
fir.mass <- c(3, 1, 4, 10, 8, 10, 3, 5, 2, 8, 7, 4, 7, 4, 10, 12, 8, 13, 16, 15, 17, 10, 18, 16, 7, 12, 13, 10, 9, 10, 11, 9, 10, 15, 14, 18, 15, 
17, 7, 17, 11, 20, 5, 6, 11, 7, 13, 12, 14, 10, 8, 10, 7, 11, 5, 6, 9, 3, 17, 4, 10, 13, 18, 13, 16, 16, 15, 17, 11, 15, 20, 15)
name <- c('K3', 'K3', 'K3', 'K3', 'K3', 'K3', 'K3', 'K3', 'D1', 'D1', 'D1', 'D1', 'D1', 'D1', 'D1', 'D1', 'B2', 'B2', 'B2', 'B2', 'B2', 'B2', 'B2', 'B2',
'D3', 'D3', 'D3', 'D3', 'D3', 'D3', 'D3', 'D3', 'K1', 'K1', 'K1', 'K1', 'K1', 'K1', 'K1', 'K1', 'D2', 'D2', 'D2', 'D2', 'D2', 'D2', 'D2', 'D2', 
'B3', 'B3', 'B3', 'B3', 'B3', 'B3', 'B3', 'B3', 'K2', 'K2', 'K2', 'K2', 'K2', 'K2', 'K2', 'K2', 'B1', 'B1', 'B1', 'B1', 'B1', 'B1', 'B1', 'B1')

pet.data <- data.frame(color, name, mass, fir.mass)

# Specify which individual belongs to which pet
kitty <- c('K1', 'K2', 'K3')
bunny <- c('B1', 'B2', 'B3')
doggy <- c('D1', 'D2', 'D3')

# Create gradually changing colors
blackcolors <- colorRampPalette(c('white', 'black'))
# I want the stacked part to be lighter in color than the bottom part
graycolors <- colorRampPalette(c('white', 'black'))

par(mfrow = c(3, 3), mar = c(4, 4, 2, 1), oma = c(0.5, 0.5, 0.5, 6), mgp = c(2.2, 0.7, 0))
for (i in 1: nlevels(pet.data$name)) {
pet.type <- ifelse(levels(pet.data$name)[i] %in% kitty, 'kitty', ifelse(levels(pet.data$name)[i] %in% bunny, 'bunny', 'doggy'))
pet.name <- levels(pet.data$name)[i]
barplot(rbind(pet.data$mass[pet.data$name == levels(pet.data$name)[i]], pet.data$fir.mass[pet.data$name == levels(pet.data$name)[i]]),
    main = substitute(paste('Size of  ', bold('lovely '), pet.type, ' (', pet.name, ')'),
    env = list(pet.type = pet.type, pet.name = pet.name)),
    xlab = 'Fir color', ylab = 'Mass', las = 1,
    names = c('White', 'Yellow', 'Orange', 'Pink', 'Red', 'Brown', 'Gray', 'Black'), col = c(blackcolors(8), graycolors(8)))
abline(h = 0)
}

# I want to add a legend in the middle right but it is not working
legend(x = 'right', y = 'middle', inset = c(-0.1, 0), legend = c('Body', 'Fir'), fill = c(blackcolors(8), graycolors(8)), bty = 'n', cex = 1.2, xpd = TRUE)

这是我得到的结果。

请问有人可以帮忙修复这个问题吗？非常感谢！

- owl

Answer 1

您可以先定义颜色：

COLS = colorRampPalette(c('grey90', 'grey10'))(24)
graycolors <- COLS[seq(1,24,by=3)]
blackcolors <- COLS[seq(3,24,by=3)]

我建议使用布局，因为您有9个图表，您可以将这些图表按照3x3的矩阵顺序排列，最后一列将是所有图例。

# don't set mfrow here
par(mar = c(4, 4, 2, 1), oma = c(0.5, 0.5, 0.5, 6), mgp = c(2.2, 0.7, 0))
LAY = cbind(matrix(1:9,ncol=3,byrow=TRUE),rep(10,3))

您需要指定列的相对宽度，以使图例列在水平方向上被“压缩”：

layout(LAY, widths=c(4,4,4,1))

然后使用内部for循环（来自koekenbakker的解决方案）与相同的图形一起，添加颜色：

for (i in 1: nlevels(pet.data$name)) {    
pet.type <- ifelse(levels(pet.data$name)[i] %in% kitty, 'kitty', ifelse(levels(pet.data$name)[i] %in% bunny, 'bunny', 'doggy'))
pet.name <- levels(pet.data$name)[i]
mat = rbind(pet.data$mass[pet.data$name == levels(pet.data$name)[i]], 
pet.data$fir.mass[pet.data$name == levels(pet.data$name)[i]])

barplot(mat,
main = substitute(paste('Size of  ', bold('lovely '), pet.type, ' (', pet.name, ')'),
env = list(pet.type = pet.type, pet.name = pet.name)),
xlab = 'Fir color', ylab = 'Mass', las = 1,
names = c('White', 'Yellow', 'Orange', 'Pink', 'Red', 'Brown', 'Gray', 'Black'), col = "white")
for (i in 1:ncol(mat)){
    xx = mat
    xx[,-i] = NA
    colnames(xx)[-i] = NA
    barplot(xx,col=c(graycolors[i],blackcolors[i]), add=T, axes=F) 
}
}
par(mai=c(0,0,0,0))
plot.new()
legend(x="center", legend = c('Body', 'Fir'),
fill = c(graycolors[1],blackcolors[1]), bty = 'n', cex = 1.2)

- StupidWolf

---

谢谢！这解决了在所有子图的中心右侧拥有共同图例的问题。您知道我如何像Wietze314的解决方案一样使用基本R更改条形颜色吗？ - owl

可以的.. 上面有看到，我会尝试将它包装成一个函数以使其更简洁。但就是这样了.. 有点复杂？哈哈 - StupidWolf

这正是我想要的！谢谢你！由于树皮质量比身体质量轻，所以我猜传说是相反的（在你的脚本中，较浅的颜色应该是身体，而较深的颜色应该是树皮）？ - owl

嗨@owl，是的感谢你指出来。我翻转了图例。但在图表中它看起来不是那么明显，所以可能需要选择其他对比度高的灰色和黑色系列作为图例。 - StupidWolf

Answer 2

这将为您提供一个起点，但使用ggplot完成。

require(tidyverse)
require(ggplot2)

pet.data %>%
  gather(key,value,-color,-name) %>%
  mutate(fillcolor = as.numeric(color) + if_else(key == 'mass',.5,0)) %>%
  ggplot(aes(x = color, y = value, fill = fillcolor, color = key)) +
  geom_bar(stat = 'identity') +
  facet_wrap(.~name) +
  scale_color_manual(values = c("black","black")) +
  scale_fill_gradient(low = "grey",high = "#111111") +
  theme_bw() +
  guides(fill = FALSE,
         color = guide_legend(title = "", override.aes = list(fill = c('#555555','grey'))))

- Wietze314

---

谢谢！是的，我想在基本R中做类似的事情。 - owl

为什么要坚持使用基本的R语言呢？正如你所看到的，使用ggplot可以使代码保持简洁。我修改了代码以提供黑白解决方案。 - Wietze314

感谢您提供的ggplot代码。与基本R相比，您的代码确实使人们明显地了解如何使用更少的代码创建类似的图形！我仍在学习如何使用ggplot，这就是我坚持使用基本R的原因之一，但对于我的目的，我也希望得到非常简单的图形，因此ggplot中默认的许多框架和线条（使图形看起来更漂亮）是否可以很容易地在ggplot中更改？ - owl

当然，你可以使用一些默认的主题，就像我使用theme_bw()一样。除此之外，通过使用theme()，你可以自定义所有的内容。 - Wietze314