条形图覆盖在Plotly R

时间:2017-03-26 05:06:55

标签: r ggplot2 plotly

我想在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")

ggplot

情节尝试:

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"))

plotly

1 个答案:

答案 0 :(得分:4)

正如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 = "")

enter image description here

完整代码

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