突出显示闪亮的文本

R noob 发表于 Dev

菜鸟

我有一个闪亮的应用程序，用户可以通过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)

我检查了类似的问题，发现这是一个紧密的突出显示，搜索类型为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) )
 })
 }
)

什里

我正在使用一个简化的示例演示执行此操作的一种方法。基本上，我创建了一个函数，该函数可以查看任何文本并使用标记来标记搜索到的单词<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)
    })
  }
)