突出闪亮的文字

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)
    })
  }
)