根据闪亮的数据表在htmlOutput中选择文本

Question

我有以下闪亮的应用程序：

library(shiny)
ui <- fluidPage(
   titlePanel("Datatable for dynamic text selection"),
   sidebarLayout(
      sidebarPanel(
        dataTableOutput("pairs")
      ),
      mainPanel(
       strong("Sentence"), htmlOutput("content"),
       strong("Selection"),textOutput("selection")
      )
   )
)

server <- function(input, output) {
   output$content <- renderText("A sample sentence for demo purpose")
   df <- data.frame(SrNo=1:5, Pairs=c("A sample", "sample sentence", 
                                      "sentence for", "for demo", "demo purpose"))
   output$pairs <- renderDataTable(datatable(df, selection = "single" ))

   observeEvent(input$pairs_cell_clicked,{
     info = input$pairs_cell_clicked
    if(is.null(info$value)) return()
    output$selection <- renderText(info$value)
   })
   }

shinyApp(ui = ui, server = server)

应用程序在htmlOutput 中显示一个句子，在datatable 中显示相应的一对单词。目前单击数据表中的任何一对单词都会在Selection下显示它。

如何修改代码，使其不显示这对单词，而是在htmlOutput 中显示为选择？

截图

Answer 1

您可以使用gsub 将选定的文本包裹在带有CSS 属性的span 中以更改背景颜色。

在您的 server.R 中，您可以尝试（代码不变的省略号）：

server <- function(input, output) {
  sample_text = "A sample sentence for demo purpose";
  output$content <- renderText(sample_text)

  .....

  observeEvent(input$pairs_cell_clicked,{

   .....

    output$content <- renderText(HTML(gsub(info$value,paste0("<span style='background-color:orange'>",info$value,"</span>"),sample_text)))
  })
}

编辑：

要模仿用户使用鼠标选择文本，您可以这样做：

select_text = JS(
                 'table.on("click.td", "tr", function () {
                            contentdiv = document.getElementById("content");
                            var selectedCell=this.lastChild;
                            var sentence = contentdiv.innerHTML;
                            var target = selectedCell.innerHTML;
                            var sentenceIndex = sentence.indexOf(target); 
                            selection = window.getSelection();
                            range = document.createRange();
                            range.setStart(contentdiv.firstChild, sentenceIndex);
                            range.setEnd(contentdiv.firstChild, (sentenceIndex + target.length));
                            selection.removeAllRanges();
                            selection.addRange(range);
                  })'
              )                                              



server <- function(input, output) {
  sample_text = "A sample sentence for demo purpose";
  output$content <- renderText(sample_text)
  df <- data.frame(SrNo=1:5, Pairs=c("A sample", "sample sentence", 
                                     "sentence for", "for demo", "demo purpose"))
  output$pairs <- renderDataTable({datatable(df, selection = "single", callback=select_text)})

  observeEvent(input$pairs_cell_clicked,{
    info = input$pairs_cell_clicked
    if(is.null(info$value)) return()
    output$selection <- renderText(info$value)  
    })
}

JS 灵感来自 this answer。