r - 添加悬停效果，例如一个(大)绘图表的工具提示？

Question

我是编程新手。我对 R 比较有经验。我正在努力生成一个大表格，其中单元格内容会从悬停在相关单元格上的鼠标光标展开。这类似于另一个问题中提出的建议: Show a tooltip or popover in Shiny datatables for each cell?

然而，在另一个示例中使用了两个表，其中表 2 作为工具提示单元格内容的引用，并且都显示了。我想只显示一张 table ，从而使一张大 table 更 slim 。

我制作了下面的示例，形状是一个小表格，引用向量包含相关列上悬停光标的额外信息。希望这足以解决问题？

当鼠标悬停在各个单元格上时，如何实现工具提示以显示引用向量的内容？

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

我想不出如何在此表上生成工具提示，从相关的“*_info”向量中检索信息。请帮忙？提前致谢。

Answer 1

如果我没理解错的话，你的问题是this solution是两个表——您要显示的表和带有工具提示的表——都显示在应用程序中。如果是这种情况，您的问题的解决方案是使用完全相同的方法，但只是隐藏带有工具提示内容的表格。使用以下数据改编的代码:

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

您还可以将 CSS 与代码放在单独的文件中以隐藏“工具提示表”，请参阅 here .