搜索框R中闪亮(Searchbox in R Shiny)

它可以添加一个普通搜索框供用户寻找在闪亮的输出部件的字符串？在下面的例子中，我想用户输入的字符串textInput控件，并有光泽突出显示匹配的文本verbatimTextOutput （或类似的东西）：

library(shiny)

text <- "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." 

ui <- fluidPage(
    sidebarPanel(
      textInput("search", "", placeholder = "Search term") 
      ),
      verbatimTextOutput("text")
  )
)


server <- function(input, output) {

  output$text <- renderText(paste(text))
}

shinyApp(ui = ui, server = server)

到目前为止，我一直在努力解决这个问题，通过拆分固定长度的行中的文本，并使用grep显示文本字符串的位置。（例如，提醒用户该字符串lorem是在第一行）。

可它在某种程度上可以更直观地做什么？

编辑

@Aurèle的答案是当场上。 DT::dataTableOutput还提供了data.tables查找的字符串，而higlighting一个搜索框功能。

这是我天真的尝试（它满足它是更直观的要求？）：

library(shiny)
library(stringr)
library(purrr)

text <- paste(
  "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."
)
insert_mark_tag <- function(s, loc_index, all_locs) {
  str_sub(s, all_locs[loc_index, 2] + 1, all_locs[loc_index, 2]) <- "</mark>"
  str_sub(s, all_locs[loc_index, 1], all_locs[loc_index, 1] - 1) <- "<mark>"
  s
}
ui <- fluidPage(
  sidebarPanel(
    textInput("search", "", placeholder = "Search term") 
  ),
  htmlOutput("text")
)
server <- function(input, output) {
  output$text <- renderText({
    m <- if (nchar(input$search)) 
      str_locate_all(text, fixed(input$search))[[1]] else 
        matrix(ncol = 2)[FALSE, ]
    HTML(reduce_right(seq_len(nrow(m)), insert_mark_tag, all_locs = m, .init = text))
  })
}
shinyApp(ui = ui, server = server)

键是str_locate_all()和str_sub<-

（您可能需要使用coll()而不是fixed()并可能取代stringr与stringi ，我不知道，如果对性能的影响将是衡量）。

我用@bartektartanus'（的合着者stringi ）回答在这里，顺便说一句，我问在评论是否有比这天真的更清洁的方式reduce()

编辑

其实，我不知道为什么我说得那么复杂。这是（多）简单（虽然它的行为有点不同WRT正则表达式）：

ui <- fluidPage(
  sidebarPanel(
    textInput("search", "", placeholder = "Search term") 
  ),
  htmlOutput("text")
)
server <- function(input, output) {
  output$text <- renderText(HTML(
    if (nchar(input$search))
      str_replace_all(text, sprintf("(%s)", input$search), "<mark>\\1</mark>") else
        text
  ))
}
shinyApp(ui = ui, server = server)