r - Plotly R 中的条形图叠加

Question

我想在 Plotly (R) 中叠加 2 个条形图，但无法弄清楚。可以在 ggplot2 中轻松完成，但 qqplotly 渲染不正确，所以我想在 plot_ly 中制作图表。感谢您的任何建议。

数据:

df = data.frame(
year = c(2014,2014,2014,2015,2015,2015,2016,2016,2016),
pet = c("dog","cat","bird","dog","cat","bird","dog","cat","bird"),
wt_before = c(56, 25, 26, 10, 19, 41, 16, 17, 13),
wt_after = c(49, 18, 19,  3, 12, 34,  9, 10,  6)
)

ggplot:

ggplot(df)+
geom_bar(aes(year,wt_before,fill=pet),stat="identity",position="dodge",width = 0.9,alpha=0.5)+
geom_bar(aes(year,wt_after,fill=pet),stat="identity",position="dodge",width = 0.9)+
xlab("Year") +
ylab("Weight")

阴谋尝试:

plot_ly(df,x= ~year) %>%
add_bars(y= ~wt_before, color = ~pet, alpha = 0.5) %>% 
add_bars(y= ~wt_after, color = ~pet, showlegend=FALSE) %>% 
layout(xaxis=list(title="Year"),
yaxis=list(title="Weight"))

Answer 1

正如 Mike Wise 所指出的，它不是一个堆积图，而是一个重叠的条形图，可能会导致奇怪的结果(如果宠物体重增加怎么办？这种信息会在图表中丢失)。您可以在彼此相邻的前后绘制重量，这会提供更多信息并涵盖所有情况。

但让我们假设我们只想拥有一个具有多个相同分类 x 值的堆积条形图。

每个条形图都需要用“虚拟”x 值绘制，即由年份 ( seq ) 和动物 ( i ) 组成的位置:

xaxis_length <- length(unique(df$year))
animal_no <- length(unique(df$pet))

i <- 0
for (animal in unique(df$pet)) {
  x <- seq(0, 
           animal_no  * xaxis_length + xaxis_length, 
           by = xaxis_length + 1) + i
  i <- i + 1
}

这些 x 值可用于绘制条形图，一个条形用于基线，一个用于差异(通过减去两个数据框列)。

for (animal in unique(df$pet)) {
  x <- seq(0, 
           animal_no  * xaxis_length + xaxis_length, 
           by = xaxis_length + 1) + i
  i <- i + 1
  p <- add_trace(p,
                 data=df[df$pet == animal, ], 
                 x = x, 
                 y = ~wt_after, 
                 type = 'bar'
                 )

  p <- add_trace(p, 
                 data=df[df$pet == animal, ], 
                 x = x,
                 y = df[df$pet == animal, ]$wt_before - df[df$pet == animal, ]$wt_after, 
                 type = 'bar'                 
  )
}

仅显示相关 x 轴刻度的值。

layout(barmode = 'stack', 
       xaxis=list(ticktext = unique(df$year),
                  tickvals = seq(1, 
                                 xaxis_length * animal_no +  xaxis_length, 
                                 by = xaxis_length + 1)
                  ),
       bargap = 0)

颜色是通过使用颜色列表并将其中一个设置为半透明和其他根本不透明来创建的。

colors <- c('rgba(97,156,255,', 
            'rgba(0,186,56,', 
            'rgba(248,118,109,') 
marker=list(color = paste(colors[[animal]], 
                          ",0.5)", 
                          sep = "")

完整代码

library(plotly)
df = data.frame(
  year = c(2014, 2014, 2014, 2015, 2015, 2015, 2016, 2016, 2016, 2017, 2017, 2017),
  pet = c("dog", "cat", "bird", "dog", "cat", "bird", "dog", "cat", "bird", "dog", "cat", "bird"),
  wt_before = c(56, 25, 26, 10, 19, 41, 16, 17, 13, 20, 25, 30),
  wt_after = c(49, 18, 19,  3, 12, 34,  9, 10,  6, 15, 20, 22)
)

colors <- c('rgba(97,156,255,', 
            'rgba(0,186,56,', 
            'rgba(248,118,109,')

xaxis_length <- length(unique(df$year))
animal_no <- length(unique(df$pet))

names(colors) <- unique(df$pet)

p <- plot_ly() %>% layout(barmode = 'stack') %>% 
  layout(barmode = 'stack', 
         xaxis=list(ticktext = unique(df$year),
                    tickvals = seq(1, 
                                   xaxis_length * animal_no +  xaxis_length, 
                                   by = xaxis_length + 1)
                    ),
         bargap=0)

i <- 0
for (animal in unique(df$pet)) {

  x <- seq(0, 
           animal_no  * xaxis_length + xaxis_length, 
           by = xaxis_length + 1) + i
  i <- i + 1
  p <- add_trace(p,
               data=df[df$pet == animal, ], 
               x = x, 
               y = ~wt_after, 
               type = 'bar', 
               name = animal,
               marker = list(color = paste(colors[[animal]], 
                                           ",1)", 
                                           sep = "")
                           ),
               legendgroup = animal,
               text = ~wt_after,
               hoverinfo = 'text'
               )

  p <- add_trace(p, 
                 data=df[df$pet == animal, ], 
                 x = x,
                 y = df[df$pet == animal, ]$wt_before - df[df$pet == animal, ]$wt_after, 
                 type = 'bar', 
                 name = animal,
                 marker=list(color = paste(colors[[animal]], 
                                           ",0.5)", 
                                           sep = "")
                             ),
                 legendgroup = animal,
                 showlegend = FALSE,
                 text = ~wt_before,
                 hoverinfo = 'text'

  )
}
p