Conditional css styling in R shiny app on selectizeInput (based on input from colourInput)

问题

Following on from this example can anyone please tell me if it's possible to update the colours of my selectizeInput based on input from the colourInput.

## load iris dataset
data(iris)
cats <- levels(iris$Species)

## colourInput ---- create list of shiny inputs for UI
ids <-  paste0("col", seq(3))
cols <- c("red", "blue", "yellow")
foo <- function(x) {colourInput(ids[x], cats[x], cols[x])}
my_input <- lapply(seq(ids), foo)

## css styling for selectizeInput menu
CSS <- function(values, colors){
  template <- "
.option[data-value=%s], .item[data-value=%s]{
  background: %s !important;
  color: white !important;
}"
  paste0(
    apply(cbind(values, colors), 1, function(vc){
      sprintf(template, vc[1], vc[1], vc[2])
    }),
    collapse = "\n"
  )
}
css <- CSS(cats, cols[seq(cats)])



## ------ shiny app ------
runApp(shinyApp(

  ui = fluidPage(
    tabsetPanel(type = "tabs",
                tabPanel("Dataset", id = "data",
                         tags$head(
                           tags$style(HTML(css))
                         ),
                         selectizeInput("species", "Labels",
                                        choices = cats,
                                        multiple = TRUE,
                                        selected = cats),
                         plotOutput("scatter")
                         ),
                tabPanel("Colour Menu", id = "colmenu",
                         my_input)
                )
  ),

  server = function(input, output, session) {  

    ## get coords according to selectizeInput 
    mrkSel <- reactive({
      lapply(input$species,
             function(z) which(iris$Species == z))
    })

    ## colours selected by user in colourPicker
    cols_user <- reactive({
      sapply(ids, function(z) input[[z]])
    })

    ## update scatter colours
    scattercols <- reactive({
      cols_user()[sapply(input$species, function(z) 
        which(cats == z))]
    })

    ## scatter plot is conditional on species selected
    output$scatter <- renderPlot({
      plot(iris$Petal.Length, iris$Petal.Width, pch=21)
      if (!is.null(input$species)) {
        for (i in 1:length(input$species)) {
          points(iris$Petal.Length[mrkSel()[[i]]], iris$Petal.Width[mrkSel()[[i]]], 
                 pch = 19, col = scattercols()[i])
        }
      }
    })   

  }
)
)

Session information

sessionInfo()
R version 4.0.0 (2020-04-24)
Platform: x86_64-apple-darwin17.0 (64-bit)
Running under: macOS High Sierra 10.13.6

Matrix products: default
BLAS:   /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib

locale:
[1] en_GB.UTF-8/en_GB.UTF-8/en_GB.UTF-8/C/en_GB.UTF-8/en_GB.UTF-8

attached base packages:
[1] stats4    parallel  stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] colorspace_1.4-1     shinythemes_1.1.2    DT_0.13              dplyr_0.8.5          pRoloc_1.29.0       
 [6] BiocParallel_1.22.0  MLInterfaces_1.68.0  cluster_2.1.0        annotate_1.66.0      XML_3.99-0.3        
[11] AnnotationDbi_1.50.0 IRanges_2.22.1       MSnbase_2.14.0       ProtGenerics_1.20.0  S4Vectors_0.26.0    
[16] mzR_2.22.0           Rcpp_1.0.4.6         Biobase_2.48.0       BiocGenerics_0.34.0  colourpicker_1.0    
[21] shinyjs_1.1          shiny_1.4.0.2        ggplot2_3.3.0

回答1:

In server:

output$css <- renderUI({
  tags$style(HTML(CSS(cats, cols_user())))
})

and in ui:

tags$head(
  uiOutput("css")
)

来源：https://stackoverflow.com/questions/61750064/conditional-css-styling-in-r-shiny-app-on-selectizeinput-based-on-input-from-co

标签

css

Shiny