Nsryjdtyk

I have a shiny app that a user searches words from a quote database through a textInput and results outputted through htmlOutput.
I want to be able to highlight the matching words within the htmlOutput as shown in the image.

An example of the code is as below:

 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)

I have checked for similar questions and found this one to be close highlight searching text on type react but address when typing and does not address multiple occurences of the word.

Any direction and suggestions are welcome.

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

 })

 }

)

I am using a simplified example to demo one way to do this. Basically, I have created a function that can look at any text and tag the searched word with <mark> tag. This tag will highlight the searched word in the output.

My regex skills are limited so the highlight function is not perfect but this approach should put you on the right track. You can research on SO or consider asking a separate question for improving this function.

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)

    })

  }

)