Searchbox in R Shiny | 易学教程

问题

It is possible to add a general search box for the user to find a string in an output widget in Shiny? In the example below, I would like the user to type a string in the textInput widget and have Shiny highlight the matching text in the verbatimTextOutput (or something similar):

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)

So far, I have been working around this problem by splitting the text in fixed-length rows and using grep to display the location of the string in the text. (For example, alerting the user that the string lorem is in the first line).

Can it somehow be done more intuitively?

Edit

@Aurèle's answer is spot on. DT::dataTableOutput also provides a searchbox feature for finding strings in data.tables, without the higlighting.

回答1:

Here is my naive attempt (does it satisfy the requirement of it being more intuitive?):

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)

The keys are str_locate_all() and str_sub<-.

(you might want to use coll() instead of fixed(), and maybe replace stringr with stringi, I have no idea if the performance impact would be measurable).

I used @bartektartanus' (co-author of stringi) answer here, btw I asked in a comment whether there is a cleaner way than this naive reduce().

Edit

Actually, I have no idea why I made it so complicated. This is (much) simpler (though it behaves a little differently wrt regexes):

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)

来源：https://stackoverflow.com/questions/47336114/searchbox-in-r-shiny

标签

javascript

css

Shiny

search-box