Блестящие приложения: возможно ли отображать HTML в сообщениях проверки?

Question

Есть ли способ визуализации HTML в сообщениях проверки блеска?Я пробовал разные подходы, используя обертку HTML, функции tags$..., а также отдельный htmlOutput для сообщения проверки, но не смог заставить ни один из них работать.Вот простой пример приложения, которое показывает эту проблему - select должно быть выделено жирным шрифтом в сообщении проверки, но теги HTML экранированы (надуманный пример, я знаю, но, надеюсь, передает идею, я бы прежде всего хотел использовать это, чтобы включитьзначки fa в сообщениях):

runApp(
  list(
    ui = fluidPage(

      titlePanel("Validation App"),

      sidebarLayout(
        sidebarPanel(
          selectInput("data", label = "Data set", choices = c("", "mtcars"))
        ),

        mainPanel(tableOutput("table"))
      )
    ),

    server = function(input, output) {

      data <- reactive({ 

        # validate test
        validate(
          need(input$data != "", HTML("Please <strong>select</strong> a data set"))
        )

        get(input$data, 'package:datasets') 
      })

      output$table <- renderTable(head(data()))

    }

  )
)

Answer 1

Самое простое решение - использовать uiOutput, а внутри функции renderUI поставить if для проверки ввода.В приведенном ниже коде приведен пример использования функций HTML и tags$....Вы также можете поставить значок.

library(shiny)
runApp(
  list(
    ui = fluidPage(
      titlePanel("Validation App"),
      sidebarLayout(
        sidebarPanel(
          selectInput("data", label = "Data set", choices = c("", "mtcars"))
        ),
        mainPanel(uiOutput("tableUI"))
      )
    ),

    server = function(input, output) {
      data <- reactive({ 
        get(input$data, 'package:datasets') 
      })

      output$tableUI <- renderUI({
        if (input$data == "") {
          div(
            HTML("Please <strong>select</strong> a data set"),
            tags$p(icon("exclamation"), "Please",tags$strong("select"), "a data set")
          ) 
        } else {
          tableOutput("table")
        }
      })

      output$table <- renderTable(head(data()))
    }

  )
)