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的启发。

根据有光泽的数据表选择htmlOutput中的文本

1 个答案: