如何在ggplotly中调整条形图？

Question

I have barchart with dual-axis in order to visualize 3 numerical variables. All these work pretty nice in ggplot. However, when I convert ggplot to ggplotly , there are issues:

1. in the legend, there are strange 1s (highlighted in yellow)
2. in the hover, there are double values (highlighted in yellow)
3. changes of hjust=0, vjust=-0.5 in geom_text are not reflected on the plot

Could anybody help me to adjust these issues?

df <- data.frame (model  = c("A", "B", "C","D","E","F"),
                  share = c(12,20,15,9,60,20),
                  sale = c(16,25,18,14,67,28),
                  cost = c(14,19,28,24,57,28))

#set levels of model by cost
df$model <- factor(df$model, levels = arrange(df, desc(df$cost))$model)

library(tidyverse)

df_long <- df %>% 
  pivot_longer(
    cols = -model
  ) 


plt <- ggplot(df_long, aes(x = model, y= value, label=value))+
  geom_col(data = filter(df_long, name != "cost"), aes(fill=name), position = position_dodge())+
  scale_fill_manual(values = c("blue", "grey"))+
  geom_line(data = filter(df_long, name == "cost"), aes(color = name, group = 1), size = 1)+
  scale_color_manual(values = "red")+
  geom_text(data = filter(df_long, name == "cost"), size = 3,hjust=0, vjust=-0.5)+
  geom_label(data = filter(df_long, name == "cost"), hjust=0, vjust=-0.5)+
  scale_y_continuous(
    name = "Sale and Share",
    sec.axis = sec_axis(~., name ="Cost")
  )+
  theme_minimal()+
  theme(legend.title=element_blank())


ggplotly(plt)

Answer 1

Legend issue:

Using the code in this post: Strange formatting of legend in ggplotly in R . You can change the legend in ggplotly like this:

library(plotly)

myplot = ggplotly(plt)
for (i in 1:length(myplot$x$data)){
  if (!is.null(myplot$x$data[[i]]$name)){
    myplot$x$data[[i]]$name =  gsub("\\(","",str_split(myplot$x$data[[i]]$name,",")[[1]][1])
  }
}

myplot

Output:

Answer 2

Further approach from @Quinten's answer,

to handle 'name name' and 'value value' things,

try

tooltip = c("value", "name", "model")
plt1$x$layout$legend$title$text <- "name"

Full code is

plt <- 
  ggplot(df_long, aes(x = model, y= value, label = NA))+
  geom_col(data = filter(df_long, name != "cost"), aes(fill=name), position = position_dodge())+
  scale_fill_manual(values = c("blue", "grey"))+
  geom_line(data = filter(df_long, name == "cost"), aes( group = 1, color = name), size = 1)+
  scale_color_manual(values = "red")+
  #geom_text(data = filter(df_long, name == "cost"), size = 3,hjust=0, vjust=-0.5)+
  geom_label(data = filter(df_long, name == "cost"), hjust=0, vjust=-0.5)+
  scale_y_continuous(
    name = "Sale and Share",
    sec.axis = sec_axis(~., name ="Cost")
  )+
  theme_minimal()

plt1 <- ggplotly(plt, tooltip = c("value", "name", "model")) 
for (i in 1:length(plt1$x$data)){
  if (!is.null(plt1$x$data[[i]]$name)){
    plt1$x$data[[i]]$name =  gsub("\\(","",str_split(plt1$x$data[[i]]$name,",")[[1]][1])
  }
}
plt1$x$layout$legend$title$text <- "name"

Answer 3

It looks like you've got some great information so far. This addresses all of the things you identified. Although, at this point, it would be a LOT easier to just make the plot in Plotly!

The first thing I did is comment out the call for geom_text and geom_label . Plotly doesn't tend to play well here. It is going back into the plot, but not here.

Next, I built your plot and looked at the names and legend groups that were assigned by the conversion. This doesn't change anything—this is just looking.

plt2 <- plotly_build(plt)

invisible(
  lapply(1:length(plt2$x$data),
         function(j) {
           message(j, " ", plt2$x$data[[j]]$name, " & ",
                   plt2$x$data[[j]]$legendgroup)
         })
)
# 1 (sale,1) & (sale,1)
# 2 (share,1) & (share,1)
# 3 (cost,1) & (cost,1)

@Quinten addressed this issue, but this is how you can just look. Once I saw what Plotly "made", I was sure I knew what I needed to change.

This code changes these strings. It also prints the update to the console so that you can inspect what you expect.

invisible(
  lapply(1:length(plt2$x$data),
         function(j) {
           x <- plt2$x$data[[j]]$name           # find the name
           y <- str_extract(x, "[a-z]+")        # remove anything that's not a letter
           plt2$x$data[[j]]$name <<- y          # put it back
           plt2$x$data[[j]]$legendgroup <<- y
           message(j, " ", plt2$x$data[[j]]$name, " & ",
                   plt2$x$data[[j]]$legendgroup)
         })
)
# 1 sale & sale
# 2 share & share
# 3 cost & cost

You can use this sort of look/change/check to validate the information that ends up in the tooltips, as well. Instead of $name or $legendgroup , you'll look at $text .

This next chunk of code doesn't check the input and print it out (I figured that would be redundant). This just changes it. (I did use that process to build this though.)

tx = " "
invisible(
  lapply(1:length(plt2$x$data),
         function(k){
           tx <<- plt2$x$data[[k]]$text # tooltip for each trace
           lapply(1:length(tx),
                  function(m) {
                    tr <- strsplit(tx[[m]], "<br />") # tooltip for each point
                    tr2 <- unique(tr[[1]])            # remove redundancy           
                    str <- paste0(tr2, collapse = "<br />")
                    tx[[m]] <<- str                   # put it back together
                  })
           plt2$x$data[[k]]$text <<- tx               # change the plot
         })
)

Now on to the labels-if you want a background or border, you have to use annotations in Plotly. Like annotation in the ggplot package, annotations in Plotly has less 'rules' per se.

You have an odd order for the model , so that has to be addressed, as well. When data moves between ggplot and Plotly, things tend to be awry . So it's unlikely that you'd be able to connect to the original data.

One thing to keep in mind, I used paper space for the x-axis. The default paper space (domain) in Plotly is [0,1]. Your graph is evenly spaced along the x, with your values in the middle of each of the six categories, so everything on the x is in terms of 1/6th space.

So first, put the data in order as it needs to appear in the plot. Then add the annotations (labels) to the plot. I've also removed the name of the legend here.

# to add labels, we need to have the order the data appears on the plot
df2 <- df_long %>% 
  arrange(desc(value)) %>% 
  filter(name == "cost")

plt2 %>% 
  layout(legend = list(title = "")) %>%  # remove legend name
  add_annotations(x = c(1/12, 1/6 + 1/12, 1/3 + 1/12, # using domain for x-axis
                        1/2 + 1/12, 2/3 + 1/12, 5/6 + 1/12),
                  y = df2$value,
                  text = df2$value,
                  xshift = 20,       # shift right 20 px
                  yshift = 15,       # shift up 15 px
                  hoverinfo = "skip",
                  bgcolor = "white",
                  bordercolor = "black",
                  xref = "paper", yref = "y", # cat x, use domain for annot x
                  showarrow = F)

After all of that, here's your plot.

This is straight plotly. I think the labels would look a bit better with padding (which can be added).

df_long %>% 
  filter(name != "cost") %>% 
  plot_ly(x = ~model, y = ~value, color = ~name, type = "bar", 
          customdata = ~name,  colors = c("blue", "gray"),
          hovertemplate = paste0("Model: %{x}<br>Value: %{y}<br>",
                                 "Name: %{customdata}<extra></extra>")) %>%
  add_lines(inherit = F, data = df, x = ~model, 
            y = ~cost, color = I("red"),
            name = "cost",
            hovertemplate = paste0("Model: %{x}<br>Value: %{y}<br>",
                                   "Name: cost<extra></extra>")) %>% 
  add_annotations(data = df, x = ~model, y = ~cost, text = ~cost,
                  bgcolor = "white", bordercolor = "black", 
                  xshift = 15, yshift = 15, showarrow = F) %>% 
  layout(barmode = "group")

Pretty much the same as the converted plot.