可折叠的checkboxGroupInput闪亮
我已经使用renderUI和checkboxGroupInput创建了一组复选框。结果如下：
我现在想要获得的是这样的东西：
仅显示顶部结果，并且可以扩展复选框列表。
关于如何获得此建议？
此复选框的代码如下：
Server.R ：
my_checkboxGroupInput <- function(variable, label,choices, selected, colors,perc){
my_names <- choices
log_funct("my_names",my_names, verbose=T)
if(length(names(choices))>0) my_names <- names(choices)
log_funct("names(my_names)",my_names, verbose=T)
log_funct("choices",choices, verbose=T)
log_funct("selected",selected, verbose=T)
div(id=variable,class="form-group shiny-input-checkboxgroup shiny-input-container shiny-bound-input",
HTML(paste0('<label class="control-label" for="',variable,'">',label,'</label>')),
div( class="shiny-options-group",
HTML(paste0('<div class="checkbox">',
'<label style="width: 100%">',
'<input type="checkbox" name="', variable,
'" value="', choices,
'"', ifelse(choices %in% selected, 'checked="checked"', ''),
'/>',
#'<span ', ifelse(choices %in% selected, paste0('style=" background-color:',colors ,'; display: inline-block; white-space: nowrap; width: ',perc, '%;"'),''), '>',my_names,'</span>',
'<span ', paste0('style=" background-color:',colors ,'; display: inline-block; white-space: nowrap; width: ',perc, '%;"'),'>',my_names,'</span>',
'</label>',
'</div>', collapse = " "))
)
)
}
output$checkbox_cond <- renderUI({
my_checkboxGroupInput("variable", "Variable:",choices = cond_plot()$Var1,
selected=c(as.character(cond_plot()$Var1)[1],as.character(cond_plot()$Var1)[2]),
colors=c('#4e71ba'),
perc= cond_plot()$perc)
})
该代码是以下代码的修改版本： how to make the checkboxgroupinput color-coded in Shiny
编辑
我已针对可能的情况调整了斯蒂芬的答案。这是工作代码：
my_checkboxGroupInput <- function(variable, label,choices, selected, colors,perc){
my_names <- choices
if(length(names(choices))>0) my_names <- names(choices)
div(id=variable,class="form-group shiny-input-checkboxgroup shiny-input-container shiny-bound-input",
HTML(paste0('<label class="control-label" for="',variable,'">',label,'</label>')),
div( class="shiny-options-group",
HTML(paste0('<div class="checkbox">',
'<label style="width: 100%">',
'<input type="checkbox" name="', variable,
'" value="', choices,
'"', ifelse(choices %in% selected, 'checked="checked"', ''),
'/>',
#'<span ', ifelse(choices %in% selected, paste0('style=" background-color:',colors ,'; display: inline-block; white-space: nowrap; width: ',perc, '%;"'),''), '>',my_names,'</span>',
'<span ', paste0('style=" background-color:',colors ,'; display: inline-block; white-space: nowrap; width: ',perc, '%;"'),'>',my_names,'</span>',
'</label>',
'</div>', collapse = " "))
)
)
}
output$checkbox_cond <- renderUI({
inputId="collapsibleCheckbox"
label="Options:"
i=3
choices = cond_plot()$Var1
selected=c(as.character(cond_plot()$Var1)[1])
colors=c('#4e71ba')
perc= cond_plot()$perc
input <- my_checkboxGroupInput(inputId, label,choices = cond_plot()$Var1,
selected=c(as.character(cond_plot()$Var1)[1],as.character(cond_plot()$Var1)[2]),
colors=c('#4e71ba'),
perc= cond_plot()$perc)
checkboxes <- input[[3]][[2]][[3]][[1]]
id_btn <- paste0(inputId, "_btn")
id_div <- paste0(inputId, "_collapsible")
btn <- actionButton(id_btn, "More...",
icon = icon("collapse-up", lib = "glyphicon"),
class = "btn-primary btn-sm",
`data-toggle`="collapse",
`data-target` = paste0("#", id_div))
checkboxelements<-paste(strsplit(input$children[[2]]$children[[1]],"</label></div>")[[1]],"</label></div>",sep="")
checkboxes_1_i=paste0(checkboxelements[1:i],collapse = "")
checkboxes_i_end=paste0(checkboxelements[(i+1):length(checkboxelements)],collapse = "")
children <- HTML(paste0(checkboxes_1_i, "<div id=",id_div," class='collapse'>",checkboxes_i_end,"</div>", btn,collapse=""))
input[[3]][[2]][[3]][[1]] <- children
script <- sprintf('$(document).ready(function(){
$("#%s_collapsible").on("hide.bs.collapse", function(){
$("#%s_btn").html("<span class=\\\"glyphicon glyphicon-collapse-down\\\"></span> More...");
});
$("#%s_collapsible").on("show.bs.collapse", function(){
$("#%s_btn").html("<span class=\\\"glyphicon glyphicon-collapse-up\\\"></span> Less...");
});
});', inputId, inputId, inputId, inputId)
tagList(tags$html(input), tags$script(HTML(script)))
})
1 个答案:
答案 0 :(得分：2)
library(shiny)
collapsibleCheckboxGroupInput <-
function(inputId, label, i, choices = NULL, selected = NULL, width = NULL,
choiceNames = NULL, choiceValues = NULL){
input <- checkboxGroupInput(inputId, label, choices = choices,
selected = selected, width = width,
choiceNames = choiceNames,
choiceValues = choiceValues)
checkboxes <- input[[3]][[2]][[3]][[1]]
id_btn <- paste0(inputId, "_btn")
id_div <- paste0(inputId, "_collapsible")
btn <- actionButton(id_btn, "More...",
icon = icon("collapse-up", lib = "glyphicon"),
class = "btn-primary btn-sm",
`data-toggle`="collapse",
`data-target` = paste0("#", id_div))
collapsible <- div(id = id_div, class = "collapse")
collapsible$children <- checkboxes[(i+1):length(checkboxes)]
children <- c(checkboxes[1:i], list(btn), list(collapsible))
input[[3]][[2]][[3]][[1]] <- children
script <- sprintf('$(document).ready(function(){
$("#%s_collapsible").on("hide.bs.collapse", function(){
$("#%s_btn").html("<span class=\\\"glyphicon glyphicon-collapse-down\\\"></span> More...");
});
$("#%s_collapsible").on("show.bs.collapse", function(){
$("#%s_btn").html("<span class=\\\"glyphicon glyphicon-collapse-up\\\"></span> Less...");
});
});', inputId, inputId, inputId, inputId)
tagList(input, tags$script(HTML(script)))
}
ui <- fluidPage(
collapsibleCheckboxGroupInput(
"checkboxes", "Make your choice:", i = 2,
choiceNames = list("Choice A", "Choice B", "Choice C", "Choice D", "Choice E"),
choiceValues = list("A", "B", "C", "D", "E")
),
br(),
verbatimTextOutput("choices")
)
server <- function(input, output){
output[["choices"]] <- renderPrint({
input[["checkboxes"]]
})
}
shinyApp(ui, server)
shinyWidgets更时尚：
library(shiny)
library(shinyWidgets)
collapsibleAwesomeCheckboxGroupInput <-
function(inputId, label, i, choices = NULL, selected = NULL,
status = "primary", width = NULL){
input <- awesomeCheckboxGroup(inputId, label, choices = choices,
selected = selected, width = width,
status = status)
checkboxes <- input[[3]][[2]][[3]][[1]]
id_btn <- paste0(inputId, "_btn")
id_div <- paste0(inputId, "_collapsible")
btn <- actionButton(id_btn, "More...",
style = "margin-bottom: 12px",
icon = icon("collapse-up", lib = "glyphicon"),
class = "btn-primary btn-sm",
`data-toggle`="collapse",
`data-target` = paste0("#", id_div))
collapsible <- div(id = id_div, class = "collapse")
collapsible$children <- checkboxes[(i+1):length(checkboxes)]
children <- c(checkboxes[1:i], list(btn), list(collapsible))
input[[3]][[2]][[3]][[1]] <- children
script <- sprintf('$(document).ready(function(){
$("#%s_collapsible").on("hide.bs.collapse", function(){
$("#%s_btn").html("<span class=\\\"glyphicon glyphicon-collapse-down\\\"></span> More...");
});
$("#%s_collapsible").on("show.bs.collapse", function(){
$("#%s_btn").html("<span class=\\\"glyphicon glyphicon-collapse-up\\\"></span> Less...");
});
});', inputId, inputId, inputId, inputId)
tagList(input, tags$script(HTML(script)))
}
ui <- fluidPage(
collapsibleAwesomeCheckboxGroupInput(
"checkboxes", "Make your choice:", i = 2,
choices = list("Choice A" = "A", "Choice B" = "B", "Choice C" = "C",
"Choice D" = "D", "Choice E" = "E")
),
br(),
verbatimTextOutput("choices")
)
server <- function(input, output){
output[["choices"]] <- renderPrint({
input[["checkboxes"]]
})
}
shinyApp(ui, server)
使用shintWidgets::actionBttn更时尚：
library(shiny)
library(shinyWidgets)
collapsibleAwesomeCheckboxGroupInput <-
function(inputId, label, i, choices = NULL, selected = NULL,
status = "primary", width = NULL){
input <- awesomeCheckboxGroup(inputId, label, choices = choices,
selected = selected, width = width,
status = status)
checkboxes <- input[[3]][[2]][[3]][[1]]
id_btn <- paste0(inputId, "_btn")
id_div <- paste0(inputId, "_collapsible")
btn <- actionBttn(id_btn, "More...", color = "primary", size = "sm",
style = "minimal", icon = icon("collapse-up", lib = "glyphicon"))
collapsible <- div(id = id_div, class = "collapse")
collapsible$children <- checkboxes[(i+1):length(checkboxes)]
children <- c(checkboxes[1:i], list(btn), list(collapsible))
input[[3]][[2]][[3]][[1]] <- children
script <- sprintf('$(document).ready(function(){
$("#%s_btn").attr("data-target", "#%s_collapsible").attr("data-toggle", "collapse").css("margin-bottom", "11px");
$("#%s_collapsible").on("hide.bs.collapse", function(){
$("#%s_btn").html("<span class=\\\"glyphicon glyphicon-collapse-down\\\"></span> More...");
});
$("#%s_collapsible").on("show.bs.collapse", function(){
$("#%s_btn").html("<span class=\\\"glyphicon glyphicon-collapse-up\\\"></span> Less...");
});
});', inputId, inputId, inputId, inputId, inputId, inputId)
tagList(input, tags$script(HTML(script)))
}
ui <- fluidPage(
collapsibleAwesomeCheckboxGroupInput(
"checkboxes", "Make your choice:", i = 2,
choices = list("Choice A" = "A", "Choice B" = "B", "Choice C" = "C",
"Choice D" = "D", "Choice E" = "E")
),
br(),
verbatimTextOutput("choices")
)
server <- function(input, output){
output[["choices"]] <- renderPrint({
input[["checkboxes"]]
})
}
shinyApp(ui, server)
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？