Add hovereffects e.g. tooltip to one (large) plotly table?

Question

I am new to programming. I am only fairly experienced with R. I am struggling to generate a large table where cell contents would expand from hovering mouse cursor on a relevant cell. This is similar to the proposed in this other question: Show a tooltip or popover in Shiny datatables for each cell?

However in this other example two tables are used, where Table 2 as a reference for tooltip cell content, and both are shown. I'd like to have just one table showing, thus making a large table slimmer.

I have produced the example below, in the shape of a small table, and reference vectors containing extra information for the hovering cursor on relevant columns. Hopefully this is useful enough for a resolution?

How can I implement a tooltip to show contents of the reference vectors when respective cells are hovered over with a mouse?

library(plotly)
#Preparing the dataset
SeqName<-c("1", "2", "3", "4", "5", "6")
Length<-c("440", "511", "1087", "686", "867", "632")
Cys<-c("3", "2", "2", "2", "2", "4")
NT<-c("[NA]", "[B]", "[B]", "[B]", "[B]", "[B]")
NR<-c("[NA]", "[B][M]", "[B]", "[B][M]", "[B][M]", "[NA]")
RefSeq<-c("[NA]", "[B][M]", "[B]", "[B][M]", "[B][M]", "[NA]")
data<-data.frame(SeqName, Length, Cys, NT, NR, RefSeq)

#making the table from the dataset
plot_ly(type="table",header=list(values=names(data)), cells=list(values=unname(data)))

#Text for tooltip to work on relevant columns
NT_info<-c("---NA---", "Solenopsis invicta uncharacterized LOC105206585 (LOC105206585) mRNA", "Pogonomyrmex barbatus glucose transporter type 1 (LOC105425888) transcript variant mRNA", "Solenopsis invicta RNA-directed DNA polymerase from mobile element jockey-like (LOC105204251) mRNA", "Solenopsis invicta uncharacterized LOC105205677 (LOC105205677) mRNA", "Zebrafish DNA sequence from clone DKEY-103J14 in linkage group complete sequence"),
NR_info<-c("---NA---", "PREDICTED: uncharacterized protein LOC105206585, partial", "glucose transporter type 1 isoform X7", "RNA-directed DNA polymerase from mobile element jockey-like", "rna-directed dna polymerase from mobile element jockey", "---NA---")
RefSeq_info<-c("---NA---", "---NA---", "GTR1_DROME Glucose transporter type 1 OS=Drosophila melanogaster GN=Glut1 PE=2 SV=4", "---NA---", "---NA---", "---NA---")   

I cannot figure how to produce a tooltip on this table retrieving information from the relevant '*_info' vectors. Please help? Thanks in advance.

Answer 1

If I understand correctly, your problem with this solution is that both tables -- the one you want to show and the one with tooltips -- are displayed in the app. If that is the case, the solution to your problem is to use exactly the same approach but just hide the table with tooltip content. Adapted code with your data below:

library(shiny)
library(DT)

shinyApp(

  ui = fluidPage(

    shiny::tags$head(shiny::tags$style(HTML("
                                            #tableWithHoverData {
                                            visibility: hidden;
                                            height: 1px !important;
                                            }
                                            #tableWithHoverData * {
                                            visibility: hidden;
                                            height: 1px !important;
                                            }
                                            "))
    ),

    dataTableOutput('mytable'),
    dataTableOutput('tableWithHoverData'),
    p("Text below table, 'tableWithHoverData' does not occupy space")
    ),

  server = function(session, input, output) {

    SeqName<-c("1", "2", "3", "4", "5", "6")
    Length<-c("440", "511", "1087", "686", "867", "632")
    Cys<-c("3", "2", "2", "2", "2", "4")
    NT<-c("[NA]", "[B]", "[B]", "[B]", "[B]", "[B]")
    NR<-c("[NA]", "[B][M]", "[B]", "[B][M]", "[B][M]", "[NA]")
    RefSeq<-c("[NA]", "[B][M]", "[B]", "[B][M]", "[B][M]", "[NA]")

    table_show <- data.frame(SeqName, Length, Cys, NT, NR, RefSeq)

    NT_info<-c("---NA---", "Solenopsis invicta uncharacterized LOC105206585 (LOC105206585) mRNA", "Pogonomyrmex barbatus glucose transporter type 1 (LOC105425888) transcript variant mRNA", "Solenopsis invicta RNA-directed DNA polymerase from mobile element jockey-like (LOC105204251) mRNA", "Solenopsis invicta uncharacterized LOC105205677 (LOC105205677) mRNA", "Zebrafish DNA sequence from clone DKEY-103J14 in linkage group complete sequence")
    NR_info<-c("---NA---", "PREDICTED: uncharacterized protein LOC105206585, partial", "glucose transporter type 1 isoform X7", "RNA-directed DNA polymerase from mobile element jockey-like", "rna-directed dna polymerase from mobile element jockey", "---NA---")
    RefSeq_info<-c("---NA---", "---NA---", "GTR1_DROME Glucose transporter type 1 OS=Drosophila melanogaster GN=Glut1 PE=2 SV=4", "---NA---", "---NA---", "---NA---")   

    # for columns where you don't want hover, add NAs
    table_tooltip <- data.frame(rep(NA, 6), rep(NA, 6), rep(NA, 6), NT_info, NR_info, RefSeq_info)

    observeEvent(input$hoveredCellInfo, {
      info <- input$hoveredCellInfo
      content <- as.character(table2[info$row, info$column])
    })

    output$mytable <- renderDataTable({
      datatable(table_show, rownames = F,
                callback = JS("
                              table.on('mouseenter', 'tbody td', function() {
                              var column = $(this).index();
                              var hover_row = $(this).parent().index();
                              var correct_row = $('#mytable').find('tbody tr').eq(hover_row).children().first().text() - 1;

                              var dataFromOtherTable = $('#tableWithHoverData').find('tbody tr').eq(correct_row).find('td').eq(column).text();

                              this.setAttribute('title', dataFromOtherTable);
                              });

                              return table;
                              ")
                )
  })

    output$tableWithHoverData <- renderDataTable({
      datatable(table_tooltip, rownames = F)
    })
  }
      )

You can also put CSS with code to hide 'tooltip table' in separate file, see here.