javascript - R Shiny 中的搜索框

Question

可以为用户添加一个通用搜索框以在 Shiny 的输出小部件中查找字符串吗？在下面的示例中，我希望用户在 textInput 小部件中键入一个字符串，并让 Shiny 在 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 中查找字符串，无需突出显示。

Answer 1

这是我天真的尝试(是否满足更直观的要求？):

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 的合著者)回答here , 顺便说一句，我在评论中问是否有比这个天真的更干净的方法 reduce() .

编辑

其实，我也不知道为什么要把它搞得这么复杂。这(简单得多)(尽管它的行为与正则表达式略有不同):

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)