html - 如何在 R 闪亮的 modalDialog() 函数的标题中添加背景颜色和图标？

Question

我有以下代码。

library(shiny)
library(dplyr)
library(DT)

app <- shinyApp(
  ui = fluidPage(
    tags$head(tags$style("#modal1 .modal-header {background-color: #339FFF}")),
    DT::dataTableOutput("mydatatable")
  ),
  
  
  server =  shinyServer(function(input, output, session) {
    
    mycars <- reactive({ head(mtcars)})
    output$mydatatable = DT::renderDataTable(mycars(), selection = 'single',  
                                             rownames = FALSE, options = list(dom = 't'))
    selected_row <- reactiveVal(value = NULL)
    observeEvent(input$mydatatable_rows_selected,{
      selected_row(input$mydatatable_rows_selected)
    })
    
    observeEvent(selected_row(), {
      showModal(tags$div(id="modal1", modalDialog(
        title = tags$a(style = "color: black", icon('robot'), br(), 'Query Text'),
        tags$div(HTML(paste(
          "cyl = ",
          tags$span(mycars()$cyl[selected_row()],
                    style = paste("color:", if (mycars()$mpg[selected_row()] > 21) {
                      "red"
                    } else {
                      "blue"
                    })
          )
        )))
      )))
    })
  })
)

app

我的目标是更改标题的背景颜色，类似于我在 modalDialog() 中的 cyl 值的颜色，并且如果 cyl <= 6 并且如果 cyl > 6 则在标题中添加一个机器人图标，如果 cyl > 6 则添加一个用户图标，如下图所示。

怎么可能在 R 闪亮？提前感谢=）

标签： htmlcssrshinymodal-dialog

Answer 1

library(shiny)
library(dplyr)
library(DT)



app <- shinyApp(
  ui = fluidPage(
    uiOutput("code"),
    DT::dataTableOutput("mydatatable")
  ),
  
  
  server =  shinyServer(function(input, output, session) {
    
    mycars <- reactive({ head(mtcars)})
    output$mydatatable = DT::renderDataTable(mycars(), selection = 'single',  
                                             rownames = FALSE, options = list(dom = 't'))
    selected_row <- reactiveVal(value = NULL)
    observeEvent(input$mydatatable_rows_selected,{
      selected_row(input$mydatatable_rows_selected)
    })
    
    output$code <- renderUI({
      validate(need(!is.null(selected_row()) & nrow(mycars()) > 0, " "))
      
      if (mycars()$mpg[selected_row()] > 21) {
        tags$head(tags$style("#modal1 .modal-header {background-color: #FFD8D8; text-align: center}"))
      } else {
        tags$head(tags$style("#modal1 .modal-header {background-color: #339FFF; text-align: center}"))
      }
    })
    
    f <- function(){
      if (mycars()$mpg[selected_row()] > 21){
        tags$a(style = "color: black", icon('robot'), br(), 'Query Text')
      } else{
        tags$a(style = "color: black", icon('users'), br(), 'Query Text')
      }
    }
    
    observeEvent(selected_row(), {
      showModal(tags$div(id="modal1", modalDialog(
        title = f(),
        tags$div(HTML(paste(
          "cyl = ",
          tags$span(mycars()$cyl[selected_row()],
                    style = paste("color:", if (mycars()$mpg[selected_row()] > 21) {
                      "red"
                    } else {
                      "blue"
                    })
          )
        )))
      )))
    })
  })
)

app