2

I have data of sales by year and model, which is visualized via Sankey chart and plotly (Previous question). However, I have some issues concerning hover which I want to handle. More precisely hover only shows model but not sales information each year:

enter image description here

If we turn the hover to the second mode, it traces everything together but model: F is accidentally shown on the chart for no reason: enter image description here

Code:

df <- data.frame (model  = c("A","B","C","D","E","F","G","H","I","J","A","B","C","D","E","F","G","H","I","J","A","B","C","D","E","F","G","H","I","J","A","B","C","D","E","F","G","H","I","J","A","B","C","D","E","F","G","H","I","J","A","B","C","D","E","F","G","H","I","J"),
 Year = c(2015,2015,2015,2015,2015,2015,2015,2015,2015,2015,2016,2016,2016,2016,2016,2016,2016,2016,2016,2016,2017,2017,2017,2017,2017,2017,2017,2017,2017,2017,2018,2018,2018,2018,2018,2018,2018,2018,2018,2018,2019,2019,2019,2019,2019,2019,2019,2019,2019,2019,2020,2020,2020,2020,2020,2020,2020,2020,2020,2020),
                  sales = c(450,678,456,344,984,456,234,244,655,789,234,567,234,567,232,900,1005,1900,450,345,567,235,456,345,144,333,555,777,111,444,222,223,445,776,331,788,980,1003,456,434,345,2222,3456,456,678,8911,4560,4567,4566,5555,6666,7777,8888,1233,1255,5677,3411,2344,6122,4533))

##################################################################################################

library(ggsankey)
library(tidyverse)
library(plotly)

# df from the question is unchanged

# visualize the original
(plot <- ggplot(df, 
              aes(Year, node = model, fill = model, value = sales)) + 
    geom_sankey_bump(space = 0, type = "alluvial", 
                     color = "transparent", smooth = 15) +
    scale_fill_viridis_d(option = "A", alpha = .8) +
    theme_sankey_bump(base_size = 16)) 

ggplotly(plot) -> plp 
plp

#-------- colors --------
# collect the 10 colors
cols <- map_dfr(1:10, function(k){
  nm <- plp$x$data[[k]]$name
  filler <- plp$x$data[[k]]$fillcolor
  c(nm = nm, filler = filler)
})

##################################################################################################

#--------------- collect values for hovertext positions ----------
x <- plp$x$data[[1]]$x
inds <- which(x %in% 2015:2020, arr.ind = T)
yrs <- x[inds]

tellMe <- invisible(
  map(1:length(plp$x$data),
      function(m) {
        y <- plp$x$data[[m]]$y
        y[inds]
      }) %>% setNames(sort(unique(df$model))) %>% # changed from LETTERS[1:10] 
    as.data.frame() %>% 
    mutate(yr = yrs %>% as.integer()) %>% 
    pivot_longer(names_to = "model", values_to = "sales", 
                 cols = sort(unique(df$model))) %>% 
    distinct() %>% 
    group_by(yr, model) %>% 
    summarise(val = mean(sales)) %>% 
    left_join(df, by = c("yr" = "Year", "model" = "model")) %>% 
    as.data.frame() # drop groups
)

#-------------- create data trace for hovertext --------------
plot_ly(tellMe, x = ~yr, y = ~val, split = ~model, 
        customdata = ~sales, text = ~model,
        line = list(width = .01, shape = "spline", smoothing = 1.3),
        hovertemplate = "Year: %{x}<br>Model: %{text}<br>Sales: %{customdata}<extra></extra>",
        type = "scatter", mode = "lines", showlegend = F) -> pp2
pp2
##################################################################################################

# change colors to match sankey
pp2 <- plotly_build(pp2)
invisible(
  map(1:10,
      function(z) {
        nm <- pp2$x$data[[z]]$name
        # collect and assign the color
        cr <- unlist(cols[cols$nm == nm, "filler"], use.names = F)
        pp2$x$data[[z]]$line$color <<- cr
      })
)

#################################################################################################################################
#-------------- consolidate the traces (subplot won't work) -----------
# collect data one more time!
dx <- plp$x$data
yx <- pp2$x$data
yx <- append(yx, dx) # put plt on top

# replace data 
plp$x$data <- yx

# lines are small, increase the distance searched for matches
plp %>% layout(hoverdistance = 40)
Improve this question

1 Answer 1

Reset to default
2

Right before you call the plot, you could use this to remove the hover data that only includes "Model ..."

It seems that if you do it and then do a bunch of manipulation, you get some odd results, like Plotly re-adding this information. So this has to be done towards the end.

invisible(map(
  1:length(plp$x$data),
  function(k){
    x <- length(plp$x$data[[k]]$x)
    if(x > 3000) {
      plp$x$data[[k]]$text <<- NULL
      plp$x$data[[k]]$hoverinfo <<- "none"
    }
  }
))

Without the other label, you could improve the hover response with a larger increase in hoverdistance.

plp %>% layout(hoverdistance = 80)

enter image description here enter image description here enter image description here

Improve this answer
Sign up to request clarification or add additional context in comments.

4 Comments

Is that possible to automatize these manipulations? In order to avoid editing code for every single data set?
I am asking because I am not sure where this line comes from: x > 3000
That is how many x-axis values are in the Sankey part of this graph. I'm not sure what's typical of this type of plot. However, I can say that there are only six x-axis values in the data added for the hover text. If you used the same method for hover text, or if you knew the number of initial unique values you had for the x-axis, then you could just look for traces with more values than that.
@Kat stackoverflow.com/questions/73460576/…

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.