1

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
lmsimp
  • 882
  • 7
  • 22

1 Answers1

4

In server:

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

and in ui:

tags$head(
  uiOutput("css")
)
Stéphane Laurent
  • 75,186
  • 15
  • 119
  • 225