lmsimp
lmsimp

Reputation: 932

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         

Upvotes: 1

Views: 754

Answers (1)

St&#233;phane Laurent
St&#233;phane Laurent

Reputation: 84519

In server:

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

and in ui:

tags$head(
  uiOutput("css")
)

Upvotes: 4

Related Questions