Question

我有一个闪亮的应用程序，用户可以通过textInput从报价数据库中搜索单词，并通过htmlOutput输出结果。我希望能够突出显示htmlOutput中的匹配单词，如图所示。

代码示例如下：

 library(shiny)
 library(shinydashboard)


ui <- dashboardPage(
   dashboardHeader(),
  dashboardSidebar(
  sidebarMenu(
  menuItem("TexSearch", tabName = "Tabs", icon = icon("object-ungroup"))

  )
 ),
 dashboardBody(
   tabItem(tabName = "Tabs",
        fluidRow(
          column(width=3, 
                 box(
                   title="Search ",
                   solidHeader=TRUE,
                   collapsible=TRUE,
                   width=NULL,
                   textInput("quoteSearch", " Search ",  '', placeholder = "Type keyword/statement"),
                   submitButton("Search")
                 )
          ),

          column( width=9,
                  tabBox(
                    width="100%",
                    tabPanel("tab1", 
                             htmlOutput("quotesearchdetails")
                    )))))))

 server <- function(input, output) {
  output$quotesearchdetails <-renderUI({
   outputed=""
   author <- c('John Cage','Thomas Carlyle','Elbert Hubbard', 'Albert Einstein')
   quote <- c('I cant understand why people are frightened of new ideas. Im frightened of the old ones.','The tragedy of life is not so much what men suffer, but rather what they miss.','The greatest mistake you can make in life is to be continually fearing you will make one.', 'Anyone who has never made a mistake has never tried anything new.')

  quotes <- data.frame(author, quote)

if(input$quoteSearch!=""){
  words<-strsplit(input$quoteSearch,",")
  words<-as.character(words[[1]])
  words<-tolower(words)
  for(i in 1:length(words)){
    quotes<-quotes[
      grepl(words[i],quotes$quote),]

  }
  if (dim(quotes)[1]>0){
    for(i in seq(from=1,to=dim(quotes)[1])){ 

      outputed<-paste(outputed,
                 paste("Author: ",quotes[i,"author"]),
                 sep="<br/><br/>")
      outputed<-paste(outputed,
                 paste("Quote: ",quotes[i,"quote"]),
                 sep="<br/><br/>")

    }

  } else {outputed- "No quotes found."}
}

HTML(outputed)
 })


 }
 shinyApp(ui, server)

我检查了类似的问题，发现这个问题很接近highlight searching text on type react，但在键入时可以解决，但不能解决单词多次出现的问题。

欢迎任何方向和建议。

  library(shiny)

  highlight <- function(text, search) {
  x <- unlist(strsplit(text, split = " ", fixed = T))
  x[tolower(x) %in% tolower(c(search1, search2))] <- paste0("<mark>", 
 x[tolower(x) %in% tolower(c(search1, search2))], "</mark>")
 paste(x, collapse = " ")
   }

  shinyApp(
 ui = fluidPage(
  textInput("search1", "Search"),
 textInput("search2", "Search"),
 br(), br(),
 htmlOutput("some_text")
  ),
    server = function(input, output, session) {
     output$some_text <- renderText({
    highlight("Author: Albert Einstein<br/>Quote: The greatest mistake you 
can make in life is to be continually fearing you will make one", c(input$search1, input$search2) )
 })
 }
)

Answer 1

我正在使用一个简化的示例演示执行此操作的一种方法。基本上，我创建了一个可以查看任何文本并使用<mark>标签标记搜索到的单词的函数。该标签将在输出中突出显示搜索到的单词。

我的正则表达式技能有限，因此highlight功能并不完美，但是这种方法应该可以使您走上正确的道路。您可以研究SO，也可以考虑问一个单独的问题来改善此功能。

library(shiny)

highlight <- function(text, search) {
  x <- unlist(strsplit(text, split = " ", fixed = T))
  x[tolower(x) == tolower(search)] <- paste0("<mark>", x[tolower(x) == tolower(search)], "</mark>")
  paste(x, collapse = " ")
}

shinyApp(
  ui = fluidPage(
    textInput("search", "Search"),
    br(), br(),
    htmlOutput("some_text")
  ),
  server = function(input, output, session) {
    output$some_text <- renderText({
      highlight("Author: Albert Einstein<br/>Quote: The greatest mistake you can make in life is to be continually fearing you will make one", input$search)
    })
  }
)

突出显示闪亮的文本

1 个答案: