Question

我需要用户将文本片段分配给类别或＆＃34;代码＆＃34;在闪亮。基本上，我希望用户突出显示输出中的文本（在下面的示例中，从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确实对此有用，不确定是否有必要，但它肯定更容易。

我的回答基于this answer，以便在js和this answer中显示突出显示的文字，以便将数据从js发送到R，原作者

首先是简单的可重现代码，然后我将解释发生了什么：

server.R

shinyServer(function(input, output, session) {

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

})

ui.R

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的{{1}}变量的内容分配给selection mydata变量。

希望这有帮助

Answer 2

感谢@GGamba，我可以为我的例子开发以下答案：

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"
highlight <- '
                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);
};
'

coded_text <- character(0)

ui <- bootstrapPage(
  tags$script(highlight),
  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))

  coded <- eventReactive(input$code1, {
    coded_text <<- c(coded_text, input$mydata)
    coded_text
  })

  output$selected_text <- renderPrint({
    coded()
  })

}

shinyApp(ui = ui, server = server)

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

2 个答案:

server.R

ui.R