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)

R Shiny 中的搜索框

Searchbox in R Shiny

javascript

css

r

search-box

shiny