стиль checkboxGroupButtons в Shiny с использованием css

Question

Следуя за этим вопросом , может кто-нибудь, пожалуйста, скажите мне, как

(1) изменить цвет фона элементов флажка в соответствии с палитрой цветов Dynami c (согласно ниже пример) в shiny используя css пожалуйста?

(2) сделать флажки закругленными углами?

(3) удалить черный контур из флажка?

Пример:

## 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 <- "
.checkbox[data-value=%s] {
  background: %s !important;
  color: white !important;
  padding: 5px;
  margin-bottom: 10px;
}"
  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(
                           uiOutput("css")
                         ),
                         checkboxGroupButtons(
                           inputId = "species",
                           label = "Labels",
                           choices = cats,
                           justified = TRUE,
                           direction ="vertical",
                           checkIcon = list(
                             yes = icon("ok", 
                                        lib = "glyphicon"))
                         ),
                         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])
        }
      }
    }) 
    
    ## update colours
    output$css <- renderUI({
      tags$style(HTML(CSS(cats, cols_user())))
    })
    
  }
)
)

> 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 
[8] methods   base     

other attached packages:
 [1] rsconnect_0.8.16    shinyWidgets_0.5.3  dendextend_1.13.4  
 [4] tidyr_1.1.0         patchwork_1.0.1     ggplot2_3.3.1      
 [7] shinyhelper_0.3.2   colorspace_1.4-1    colourpicker_1.0   
[10] shinythemes_1.1.2   DT_0.13             shiny_1.4.0.2      
[13] dplyr_1.0.0         MSnbase_2.14.2      ProtGenerics_1.20.0
[16] S4Vectors_0.26.1    mzR_2.22.0          Rcpp_1.0.4.6       
[19] Biobase_2.48.0      BiocGenerics_0.34.0

Answer 1

CSS <- function(colors){
  template <- "
.checkboxGroupButtons div.btn-group:nth-child(%s) button {
  background: %s !important;
  color: white !important;
}"
  paste0(
    apply(cbind(seq_along(colors), colors), 1, function(vc){
      sprintf(template, vc[1], vc[2])
    }),
    collapse = "\n"
  )
}


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