R Shiny中的搜索框

时间:2017-11-16 17:48:00

标签: javascript css r shiny search-box

可以为用户添加一个常规搜索框,以便在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中查找字符串,而不需要高亮显示。

1 个答案:

答案 0 :(得分: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'({​​{1}}的合着者)回答here,顺便提一句,我在评论中询问是否有比这更天真stringi更清晰的方式。

修改

实际上,我不知道为什么我这么复杂。这(更简单)(尽管它与正则表达式的表现略有不同):

reduce()