Shiny可以识别鼠标选择的文本（突出显示的文本）吗？

Question

我需要用户将文本片段分配给Shiny中的类别或“代码”。基本上，我希望用户突出显示来自输出的文本（在下面的示例中，来自table或text输出），然后按按钮（code）并将选定的文本分配给应用程序内的对象。在下面的应用中，所选文本应呈现为output$selected_text。我希望您能就如何实现此目标提出任何建议，我怀疑JavaScript会有所帮助。

library(shiny)

text1 <- "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Fusce nec quam ut tortor interdum pulvinar id vitae magna. Curabitur commodo consequat arcu et lacinia. Proin at diam vitae lectus dignissim auctor nec dictum lectus. Fusce venenatis eros congue velit feugiat, ac aliquam ipsum gravida. Cras bibendum malesuada est in tempus. Suspendisse tincidunt, nisi non finibus consequat, ex nisl condimentum orci, et dignissim neque est vitae nulla." 
text2 <- "Aliquam ut purus neque. Maecenas justo orci, semper eget purus eu, aliquet molestie mi. Duis convallis ut erat at faucibus. Quisque malesuada ante elementum, tempor felis et, faucibus orci. Praesent iaculis nisi lorem, non faucibus neque suscipit eu. Ut porttitor risus eu convallis tristique. Integer ac mauris a ex maximus consequat eget non felis. Pellentesque quis sem aliquet, feugiat ligula vel, convallis sapien. Ut suscipit nulla leo"

ui <- bootstrapPage(
  fluidRow(
    column(4,
           tags$h1("Text to code"),
           tags$h2("From table"),
           tableOutput("table"),
           tags$h2("From raw text"),
           verbatimTextOutput("text")
    ),
    column(4,
           tags$h1("Coding options"),
           actionButton("code1", "Assign selected text to Code1"),
           tags$h1("Code1 output"),
           verbatimTextOutput("selected_text")
    )
  )
)


server <- function(input, output) {
  output$table <- renderTable({
    data.frame(paragraph = 1:2, text = c(text1, text2))
  })

  output$text <- renderText(paste(text1, text2))
}

shinyApp(ui = ui, server = server)

Answer 1

是的，它可以。
javascript确实确实有用，不确定是否有必要，但肯定会更容易。

我基于此答案获取突出显示的文本，js并根据此答案将数据从发送js至R，因此应归功于原始作者。

首先是简单的可复制代码，然后我将说明发生了什么：

服务器

shinyServer(function(input, output, session) {

    output$results = renderPrint({
        input$mydata
    })

})

用户界面

shinyUI(bootstrapPage(

    # a div named mydiv
    div(id="mydiv", "SOME text here"),

    # a shiny element to display unformatted text
    verbatimTextOutput("results"),

    # javascript code to send data to shiny server
    tags$script('
                function getSelectionText() {
                    var text = "";
                    if (window.getSelection) {
                        text = window.getSelection().toString();
                    } else if (document.selection) {
                        text = document.selection.createRange().text;
                    }
                    return text;
                }

        document.onmouseup = document.onkeyup = document.onselectionchange = function() {
            var selection = getSelectionText();
            Shiny.onInputChange("mydata", selection);
        };
        ')
))

Server.R非常简单，不需要解释，我们只需渲染的内容input$mydata。

果汁发生在以下ui.R三个方面：

• 甲div元件（带id='mydiv'）
• 文本输出，从中呈现结果 server.R
• 一个脚本标记，其中包含javascript我们需要的标记。

在script标签内部，我们首先有一个获取选择的函数。这是js答案的副本（但当js包含&&逻辑运算符时出现错误，但翻译不正确）

这个函数被调用onmouseup，onkeyup并且onselectionchange，其结果分配给selection。

最后，可能也是重要的一点，该js函数 Shiny.onInputChange("mydata", selection)将js' selection变量的内容分配给mydata R'变量。

希望这可以帮助