выделение текста на блестящем - PullRequest
Новая
       7

выделение текста на блестящем

0 голосов
/ 26 ноября 2018

У меня есть блестящее приложение, которое пользователь ищет слова из базы данных цитат через textInput и результаты выводятся через htmlOutput.Я хочу иметь возможность выделить соответствующие слова в htmlOutput, как показано на рисунке.

enter image description here

Пример кода приведен ниже: 

 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)

Я проверил похожие вопросы и обнаружил, что этот вопрос близок выделите текст для поиска по типу реагировать , но адрес при наборе текста и не затрагивает многократные вхождения слова.

Любые направления и предложения приветствуются. 

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

1 Ответ

0 голосов
/ 27 ноября 2018

Я использую упрощенный пример, чтобы продемонстрировать один из способов сделать это.По сути, я создал функцию, которая может просматривать любой текст и помечать искомое слово тегом <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)
    })
  }
)

enter image description here

...