Tooltips in plotly generated from ggplot geom_tile

I'm trying to produce an interactive plotly graphic with two vertical axes and on-hover tooltips. The plot should have y1 data as points and y2 data as bars. Everything works just as needed when I use points for data in both sides, but when I use bars for y2 I cannot get the tooltips to display the correct information.

With points at both sides tooltips display fine:

With geom_tile bars at the right side, every bar's tooltip displays the information of all the bars of the same ID:

Some complementary information that could be relevant:

I'm using geom_tile to produce the bars because I need to be able to reverse the axes and I was having difficulties doing that with other geoms. I adopted geom_tile based on this SO answer.
It is necessary to produce the plotly graphic from a ggplot one, not directly the plotly one. This is part of a large Shiny app that I got to work on, where the ggplot object is stored apart and further manipulated for other purposes.

MRE

Note: I'm not sure if my example is minimal because I don't know well what part of the process is messing up the tooltips. Thus, I prefer to include all elements of my application case here: two vertical axes, reversing and two different geoms including the problematic bars.

** Data

# for vertical axis y1 (left)
df1 <- data.frame(ID = c("A", "A", "A", "A", "B", "B", "B", "B"), 
              Date = structure(c(19078, 19085, 19092, 19099, 19078, 19085, 19092, 19099), class = "Date"),
              Val = c(236, 221, 187, 136, 77, 100, 128, 180))

# for vertical axis y2 (right)
df2 <- data.frame(ID = c("J", "J", "J", "J", "K", "K", "K", "K"), 
              Date = structure(c(19078, 19085, 19092, 19099, 19078, 19085, 19092, 19099), class = "Date"),
              Val = c(478, 500, 549, 479, 73, 5, 15, 74))

** Working case with points at both sides

library(ggplot2)
library(dplyr)
library(plotly)

# prepare y2 scaled data
ylim1 <- rev(range(df1$Val))
ylim2 <- range(df2$Val)
scale_y2.1 <- function(y, ylim1, ylim2) {
  ylim1[1] + (ylim1[2] - ylim1[1]) *(y - ylim2[1])/(ylim2[2] - ylim2[1])
}
dfAll <- full_join(df1, df2, by = c("ID", "Date"), suffix = c("1", "2"))
y2.scl <- scale_y2.1(dfAll$Val2, ylim1, ylim2)
dfAll <- dfAll %>% mutate(Val2_scl = y2.scl)

# prepare y2 ticks and scaled breaks
labs2 <- pretty(ylim2)
brks2 <- scale_y2.1(labs2, ylim1, ylim2)

# generate ggplot
ggp1 <- ggplot(dfAll) +
  geom_point(aes(x = Date, y = Val1, color = ID, group = ID), na.rm = TRUE) +
  geom_point(aes(x = Date, y = Val2_scl, group = ID, color = ID), na.rm = TRUE, shape = 4, stroke = 0.6) +
  scale_y_continuous(trans = "reverse",
                     sec.axis = dup_axis(breaks = rev(brks2), labels = rev(labs2), name = "Val2")) +
  coord_cartesian(ylim = rev(ylim1))

# generate plotly
yaxis2 <- list(overlaying = "y", range = rev(ylim2), ticks = 'outside', side = "right",
               title = "Val2", zeroline = FALSE, showgrid = FALSE, automargin = TRUE,
               tickfont = list(size = 11.8), titlefont = list(size = 14.6))
ply1 <- ggplotly(ggp1) %>%
  add_lines(x = ~Date, y = ~Val2_scl, yaxis = "y2", data = dfAll, inherit = FALSE) %>%
  style(showlegend = FALSE) %>%
  layout(yaxis2 = yaxis2)

# insert tooltips
tlTips <- paste0("Value: ", c(df1$Val, df2$Val), '\n',
                 "Date: ", dfAll$Date, '\n',
                 "ID: ", dfAll$ID)
for (i in seq_along(ply1$x$data)) {
  aName <- ply1$x$data[[i]]$name
  if (!is.null(aName)) {
    aTags <- grep(aName, tlTips, value = TRUE, fixed = TRUE)
    ply1$x$data[[i]]$text <- aTags
  }
}

# display
ply1

** Broken case with bars at right side

# generate ggplot
ggp2 <- ggplot(dfAll) +
  geom_point(aes(x = Date, y = Val1, color = ID, group = ID), na.rm = TRUE) +
  geom_tile(aes(x = Date, y = (ylim1[1] +  Val2_scl)/2, height = ylim1[1] - Val2_scl, fill = ID, group = ID),
            na.rm = TRUE, stat = "identity", position = position_dodge(preserve = "single")) +
  scale_y_continuous(trans = "reverse",
                     sec.axis = dup_axis(breaks = rev(brks2), labels = rev(labs2), name = "Val2")) +
  coord_cartesian(ylim = rev(ylim1))

# generate plotly
ply2 <- ggplotly(ggp2) %>%
  add_lines(x = ~Date, y = ~Val2_scl, yaxis = "y2", data = dfAll, inherit = FALSE) %>%
  style(showlegend = FALSE) %>%
  layout(yaxis2 = yaxis2)

# insert tooltips
for (i in seq_along(ply2$x$data)) {
  aName <- ply2$x$data[[i]]$name
  if (!is.null(aName)) {
    t1 <- grepl("(", aName, fixed = TRUE)
    t2 <- grepl(",", aName, fixed = TRUE)
    t3 <- grepl(")", aName, fixed = TRUE)
    if (all(t1, t2, t3)) {
      aName <- strsplit(sub("(", "", aName, fixed = TRUE), ",", fixed = TRUE)[[1]][1]
    }
    aTags <- grep(aName, tlTips, value = TRUE, fixed = TRUE)
    ply2$x$data[[i]]$text <- aTags
  }
}

# display
ply2

Solution

Option 1:

This modification modifies your for statement that you used to modify the tooltips. I used the plotting data for the tooltips. I'm not sure if that is the value or ID you wanted for the tiles, but you'll at least see how I changed it.

The lapply starts with if(...the trace is markers. This part of the code is mostly identical to the content in your for statement. Note the comment indicating the only thing I changed (<< instead of <). The else(... is if the trace is not markers (lines/tiles).

In the else, I extract the text, which looks like this: "Date: 2022-03-27 (ylim1[1] + Val2_scl)/2: 166.8759 ylim1[1] - Val2_scl: NA ID: J ID: J".

First I split by   (linebreaks). Then the second break ("(ylim1[1] + Val2_scl)/2: 166.8759") is split by the :. Next, I rebuild the tip in the order used in the markers (value, date, then id).

The Code

This starts with the object ggp2 from your question.

#----------- this is unchanged from your code ------------
# generate plotly
ply2 <- ggplotly(ggp2) %>%
    add_lines(x = ~Date, y = ~Val2_scl, yaxis = "y2", data = dfAll, inherit = FALSE) %>%
    style(showlegend = FALSE) %>%
    layout(yaxis2 = yaxis2)

#----------- where my mods start -------------
# this is mostly the same content as in you the question's for statement
invisible(lapply(1:length(ply2$x$data), function(i) {
  if(ply2$x$data[[i]]$mode == "markers") {  # all in `if` is from your for() statement
    aName <- ply2$x$data[[i]]$name
    if (!is.null(aName)) {
      t1 <- grepl("(", aName, fixed = TRUE)
      t2 <- grepl(",", aName, fixed = TRUE)
      t3 <- grepl(")", aName, fixed = TRUE)
      
      if (all(t1, t2, t3)) {
        aName <- strsplit(sub("(", "", aName, fixed = TRUE), ",", fixed = TRUE)[[1]][1]
      }
      aTags <- grep(aName, tlTips, value = TRUE, fixed = TRUE)
      ply2$x$data[[i]]$text <<- aTags               # <--------- this is changed!
    } 
  } else {                    # else the mode is NOT markers (tiles/lines)
    if(!is.null(ply2$x$data[[i]]$text)) {           # if text exists
      # split the current multiple stringed tooltip by line break
      aName <- strsplit(ply2$x$data[[i]]$text, "<br />", fixed = T)
      l2 <- strsplit(aName[[1]][2], ":")           # split 'Value' line
      
      # rebuild tooltip for tiles based on the order in markers tips
      #    and plotting data
      aTag <- paste0("Value:", l2[[1]][2], "<br />", aName[[1]][1], 
                     "<br />", aName[[1]][length(aName[[1]])])
      ply2$x$data[[i]]$text <<- aTag               # note the << for envir assign
    }
  }
}))
ply2

Option 2:

Thanks to Kat's suggestions, I was able to implement an approach which (i) works for combinations of geom_point() - geom_tile() and geom_line() - geom_tile(); and (ii) installs the correct Value, Date and ID on each bar. Kat's input was fundamental to have my version developed so I decided it was better to add this code as an addition to this answer rather than posting a new one.

I got back to a for loop for simplicity. Anyway it only involves a few iterations.
This time I used geom_line() in combination with geom_tile() to illustrate a case where ply2$x$data[[i]]$mode doesn't let one differentiate between lines and tiles traces. However, the code is general enough to work also if geom_point() is used in combination with geom_tile().
I prepared two separate tooltip vectors, one for other geoms different to bars and one for bars.

The Code

Starting from the ggplot object definition.

# generate ggplot
ggp2 <- ggplot(dfAll) +
  geom_line(aes(x = Date, y = Val1, color = ID, group = ID), na.rm = TRUE) +
  geom_tile(aes(x = Date, y = (ylim1[1] +  Val2_scl)/2, height = ylim1[1] - Val2_scl, fill = ID, group = ID),
            na.rm = TRUE, stat = "identity", position = position_dodge(preserve = "single")) +
  scale_y_continuous(trans = "reverse",
                     sec.axis = dup_axis(breaks = rev(brks2), labels = rev(labs2), name = "Val2")) +
  coord_cartesian(ylim = rev(ylim1))

# generate plotly
ply2 <- ggplotly(ggp2) %>%
  add_lines(x = ~Date, y = ~Val2_scl, yaxis = "y2", data = dfAll, inherit = FALSE) %>%
  style(showlegend = FALSE) %>%
  layout(yaxis2 = yaxis2)

# prepare tooltips
# - for geom_point and geom_line related traces
tlTipsOthers <- paste0("Value: ", df1$Val, '\n',
                       "Date: ", df1$Date, '\n',
                       "ID: ", df1$ID)
# - for geom_tiles related traces
tlTipsTiles <- paste0("Value: ", df2$Val, '\n',
                      "Date: ", df2$Date, '\n',
                      "ID: ", df2$ID)

# insert tooltips
tilePivs <- c()
for (i in seq_along(ply2$x$data)) { # tooltips for traces other than tiles
  # i <- 0
  # i <- i + 1
  aName <- ply2$x$data[[i]]$name
  if (!is.null(aName)) {
    t1 <- grepl("(", aName, fixed = TRUE)
    t2 <- grepl(",", aName, fixed = TRUE)
    t3 <- grepl(")", aName, fixed = TRUE)
    if (all(t1, t2, t3)) {
      aName <- strsplit(sub("(", "", aName, fixed = TRUE), ",", fixed = TRUE)[[1]][1]
    }
    
    # determine if this is a geom_tile() trace, else insert others' tooltips
    if (any(grepl(aName, tlTipsTiles, fixed = TRUE)) && ply2$x$data[[i]]$hoveron == "fills") {
      tilePivs <- c(tilePivs, i)
    } else {
      aTags <- grep(aName, tlTipsOthers, value = TRUE, fixed = TRUE)
      ply2$x$data[[i]]$text <- aTags
    }
  }
}
for (i in seq_along(tilePivs)) { # tooltips for tiles traces
  ply2$x$data[[tilePivs[i]]]$text <- tlTipsTiles[[i]]
}

# display
ply2