html - 使用 CSS 在 Shiny 中设置 checkboxGroupButtons
问题描述
继这个问题之后,有人可以告诉我如何根据动态颜色选择器(如下例所示)更改复选框项目的背景颜色shiny
吗css
?
例子:
## 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
解决方案
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())))
})
推荐阅读
- python - Python Tkinter 在 Canvas 上获取一些参数
- angular - 角游英雄教程中onSelect(hero: Hero)如何修改heres=HEROES
- node.js - 使用 execSync 在节点中运行 git clone 会删除一些文件
- flutter - 'Future 类型的值
- '不能分配给'List'类型的变量
- flask - Flask-login get_id override 阻止其他方法工作
- javascript - 为什么我在 app.js 中的 POST 登录请求总是返回 404?
- go - 从 GORM Raw() 查询中检索数据
- kotlin - 什么时候在 Kotlin 中使用“run”或“also”代替“let”?
- java - 如何使用 apache POI 从 Excel 中删除一个图表?
- c# - 线相交功能