基础R中每个条形的堆叠条形图具有不同的颜色

Question

我正在尝试创建一个带有堆叠条形图的子图的图形。我希望每个条形都有不同的颜色，并逐渐沿x轴的类别变化。我还希望每个条的堆叠部分比条的底部轻一些。它类似于this question，但我希望条形之间（而不是内部）的颜色渐变。它与this one的相似之处还在于，它的底部比条形的堆叠部分暗，但是我想看看是否有一种方法可以在基R中不使用ggplot来做到这一点。

最后，我想在整个图的右中间放置一个共同的图例，但我无法使其从右下角移动。我提到了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)

这就是我得到的。

有人可以帮助解决此问题吗？预先谢谢你！

Answer 1

这将为您提供一个良好的开端，但可以使用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'))))

Answer 2

您可以先定义颜色：

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's solution）一起使用以添加颜色：

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)