可折叠的checkboxGroupInput闪亮 [英] Collapsible checkboxGroupInput in shiny
本文介绍了可折叠的checkboxGroupInput闪亮的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我已经使用renderUI和checkboxGroupInput创建了一组复选框.结果如下:
我现在想要获得的是这样的东西:
仅在顶部显示结果，并且可以扩展复选框列表.
关于如何获得此建议?
此复选框的代码如下:
Server.R :
my_checkboxGroupInput<-函数(变量，标签，选择项，选择项，颜色，perc){my_names<-选择log_funct("my_names"，my_names，verbose = T)if(length(名称(选择))> 0)my_names<-名称(选择)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闪亮输入复选框组闪亮输入容器闪亮绑定输入"，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 ='，变量，'"value ="'，选择，''，ifelse(选择％in％，'checked =" checked'，'')，'/>'，#'< span'，ifelse(选择％in％选择，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>'，折叠="))))}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)}) 该代码是以下代码的修改版本:
使用 shinyWidgets 更时尚:
库(发光)图书馆(shinyWidgets)collapsibleAwesomeCheckboxGroupInput<-函数(inputId，label，i，choices = NULL，selected = NULL，状态=主要"，宽度= NULL){输入<-awesomeCheckboxGroup(inputId，标签，选择=选择，选定=选定，宽度=宽度，状态=状态)复选框<-input [[3]] [[2]] [[3]] [[1]]id_btn<-paste0(inputId，"_btn")id_div<-paste0(inputId，"_collapsible")btn<-actionButton(id_btn，更多..."，style ="margin-bottom:12px"，icon = icon("collapse-up"，lib ="glyphicon")，class ="btn-primary btn-sm"，`data-toggle` ="collapse"，数据目标= paste0(#"，id_div))可折叠<-div(id = id_div，class ="collapse")可折叠的$ children<-复选框[[i + 1]:length(checkboxes)]儿童<-c(复选框[1:i]，列表(btn)，列表(可折叠))输入[[3]] [[2]] [[3]] [[1]]<-儿童脚本<-sprintf('$(document).ready(function(){$(#％s_collapsible").on("hide.bs.collapse"，function(){$(#％s_btn").html(< span class = \\\" glyphicon glyphicon-collapse-down \\\>//span>更多...")；});$(#％s_collapsible").on("show.bs.collapse"，function(){$(#％s_btn").html(< span class = \\\" glyphicon glyphicon-collapse-up \\\>//span> Less ...")；});});'，inputId，inputId，inputId，inputId)tagList(输入，标签$ script(HTML(script)))}ui<-fluidPage(collapsibleAwesomeCheckboxGroupInput(复选框"，做出选择:"，i = 2，选择=列表(选择A" ="A"，选择B" ="B"，选择C" ="C"，选择D" ="D"，选择E" ="E"))，br()，verbatimTextOutput("choices"))服务器<-功能(输入，输出){输出[[选择"]]<-renderPrint({输入[[复选框"]]})}ShinyApp(用户界面，服务器)
使用 shintWidgets :: actionBttn :
库(发光)图书馆(shinyWidgets)collapsibleAwesomeCheckboxGroupInput<-函数(inputId，label，i，choices = NULL，selected = NULL，状态=主要"，宽度= NULL){输入<-awesomeCheckboxGroup(inputId，标签，选择=选择，选定=选定，宽度=宽度，状态=状态)复选框<-input [[3]] [[2]] [[3]] [[1]]id_btn<-paste0(inputId，"_btn")id_div<-paste0(inputId，"_collapsible")btn<-actionBttn(id_btn，"More ..."，color ="primary"，size ="sm"，样式=最小"，图标=图标(折叠"，lib ="glyphicon"))可折叠<-div(id = id_div，class ="collapse")可折叠的$ children<-复选框[[i + 1]:length(checkboxes)]儿童<-c(复选框[1:i]，列表(btn)，列表(可折叠))输入[[3]] [[2]] [[3]] [[1]]<-儿童脚本<-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>更多...")；});$(#％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(输入，标签$ script(HTML(script)))}ui<-fluidPage(collapsibleAwesomeCheckboxGroupInput(复选框"，做出选择:"，i = 2，选择=列表(选择A" ="A"，选择B" ="B"，选择C" ="C"，选择D" ="D"，选择E" ="E"))，br()，verbatimTextOutput("choices"))服务器<-功能(输入，输出){输出[[选择"]]<-renderPrint({输入[[复选框"]]})}ShinyApp(用户界面，服务器) I have created a set of checkbox using renderUI and checkboxGroupInput. Here the result:
What I would like to obtain now is something like this:
Where only the top results are shown with the possibility to expand the checkbox list.
Any suggestion on how to obtain this?
The code for the checkbox is the following:
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)
})
The code is a modified version of the one in: how to make the checkboxgroupinput color-coded in Shiny
EDIT
I have adapted Stephane answer to may case. Here the working code:
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)))
})
解决方案
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)
More stylish with 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)
Even more stylish, using 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)
这篇关于可折叠的checkboxGroupInput闪亮的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
