根据闪亮的数据表在htmlOutput中选择文本 [英] Select text in htmlOutput based on datatable in shiny

问题描述

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

I have the following shiny app:

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下显示它.

The app displays a sentence in htmlOutput and corresponding pair of words in datatable. At present clicking any of the pair of words in datatable displays it under the Selection.

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

How can I modify the code so that instead of displaying the pair of words, it appears as selection in htmlOutput?

屏幕截图

推荐答案

您可以使用gsub将所选文本包装在具有CSS属性的span中，以更改背景颜色.

You can use gsub to wrap the selected text in a span with a CSS attribute to change the background color.

在您的server.R中，您可以尝试(代码不变的省略号):

In your server.R, you could try (ellipsis where code doesn't change):

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

要模仿用户使用鼠标选择文本，您可以执行以下操作:

To mimic the user selecting the text using his mouse you could do:

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受此答案的启发.

这篇关于根据闪亮的数据表在htmlOutput中选择文本的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！