Colors Shining checkboxgroupinput动态背景色控件

Colors Shining checkboxgroupinput动态背景色控件,colors,background,shiny,Colors,Background,Shiny,我正在设计一个完全动态的UI,目的是用shiny进行演示。我的清单上有几个步骤,我正在一个接一个地工作 使用“checkboxGroupInput”功能自定义多选框的背景色 使复选框更具动态性--当选中/取消选中一个复选框时背景色将处于打开/关闭状态 我在另一篇文章中得到了这个解决方案,而且效果非常好。()这是我得到的密码: my_checkboxGroupInput <- function(variable, label, choices, selected, colors){ ch

我正在设计一个完全动态的UI,目的是用shiny进行演示。我的清单上有几个步骤,我正在一个接一个地工作

  • 使用“checkboxGroupInput”功能自定义多选框的背景色
  • 使复选框更具动态性--当选中/取消选中一个复选框时背景色将处于打开/关闭状态
  • 我在另一篇文章中得到了这个解决方案,而且效果非常好。()这是我得到的密码:

    my_checkboxGroupInput <- function(variable, label, choices, selected, colors){
      choices_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" style="color:', colors,'">',
                        '<label>',
                        '<input type="checkbox" name="', variable, 
                            '" value="', choices, 
                            '"', ifelse(choices %in% selected, 'checked="checked"', ''), 
                        '/>',
                        '<span>', choices_names,'</span>',
                        '</label>',
                      '</div>', collapse = " "))
          )
        )
    }
    
    library(shiny)
    my_names <- c('one'=1,'two'=2,'three'=3)
    my_selected <- c(1,2)
    my_colors <-c('blue','red','green')
    shinyApp(
      ui=fluidPage(uiOutput("my_cbgi")),
      server = function(input, output, session) {
        output$my_cbgi <- renderUI(my_checkboxGroupInput("variable", "Variable:",
                                                         choices = my_names,
                                                         selected=my_selected, 
                                                         colors=my_colors))
        }
      )
    

    my_checkboxGroupInput这里是函数的更新版本,它将为您提供预期的结果。它使用observeEvent的
    ignoreNULL
    参数跟踪上次复选框的取消选中。我必须添加一个变量来忽略第一个调用,该调用将取消选择所有初始选择:

    my_checkboxGroupInput <- function(variable, label, choices, selected, colors){
        choices_names <- choices
        if(length(names(choices))>0) choices_names <- names(choices)
        my_colors <- rep("black", length(choices))
        is_selected <- choices %in% selected
        my_colors[is_selected] <- colors[1:sum(is_selected)]
        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" style="color:', my_colors, '">',
                             '<label>',
                             '<input type="checkbox" name="', variable, 
                             '" value="', choices, 
                             '"', ifelse(is_selected, 'checked="checked"', ''), 
                             '/>',
                             '<span>', choices_names,'</span>',
                             '</label>',
                             '</div>', collapse = " "))
            )
        )
      }
    
    
    my_names <- c('one','two','three','four','five','six')
    my_selected <- c('one','two','three','four','five','six')
    my_colors <-c('blue','red','green','purple','lemon','brown')
    
    shinyApp(ui=fluidPage(uiOutput("my_cbgi")),
    
             server = function(input, output, session) {
               my <- reactiveValues(selected=my_selected, firt_call_ignore=TRUE)
               output$my_cbgi <- renderUI(my_checkboxGroupInput("variable", "Variable:",
                                                                choices = my_names, 
                                                                selected=my$selected,
                                                                colors=my_colors ))
               observeEvent(input$variable,{
                 if(my$firt_call_ignore)
                   my$firt_call_ignore=FALSE
                 else
                   my$selected <- input$variable
                 }, ignoreNULL = FALSE)
             })
    

    my_checkboxGroupInput@HubertL done!谢谢。我无法想象你为什么要这么做。嘿,我回来了。相信我,在我来问你之前,我一直都很努力。当我取消选中所有复选框时,最后一个复选框无法动态地将字体颜色更改为黑色(默认)。例如,我取消选中('1'、'2'、'3'、'5'、'6'),现在('4')的字体颜色为蓝色;然后,如果我取消选中('four'),字体颜色应该是黑色,但它保持蓝色,直到至少有一个项目被重新选中。我用多种方式尝试了条件语句,但都不起作用(一开始我试了好几次,但我没有足够的声誉将你宝贵的答案标记为“有用”。:(哦,嘘……我从来没有注意到有一个复选标记可以接受。我的道歉:(当然。你真是一位热心的专家。顺便说一句,你对我的最新问题有没有快速更新?再次感谢。尽管我一次又一次地感谢你。
    
    my_checkboxGroupInput <- function(variable, label, choices, selected, colors){
        choices_names <- choices
        if(length(names(choices))>0) choices_names <- names(choices)
        my_colors <- rep("black", length(choices))
        is_selected <- choices %in% selected
        my_colors[is_selected] <- colors[1:sum(is_selected)]
        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" style="color:', my_colors, '">',
                             '<label>',
                             '<input type="checkbox" name="', variable, 
                             '" value="', choices, 
                             '"', ifelse(is_selected, 'checked="checked"', ''), 
                             '/>',
                             '<span>', choices_names,'</span>',
                             '</label>',
                             '</div>', collapse = " "))
            )
        )
      }
    
    
    my_names <- c('one','two','three','four','five','six')
    my_selected <- c('one','two','three','four','five','six')
    my_colors <-c('blue','red','green','purple','lemon','brown')
    
    shinyApp(ui=fluidPage(uiOutput("my_cbgi")),
    
             server = function(input, output, session) {
               my <- reactiveValues(selected=my_selected, firt_call_ignore=TRUE)
               output$my_cbgi <- renderUI(my_checkboxGroupInput("variable", "Variable:",
                                                                choices = my_names, 
                                                                selected=my$selected,
                                                                colors=my_colors ))
               observeEvent(input$variable,{
                 if(my$firt_call_ignore)
                   my$firt_call_ignore=FALSE
                 else
                   my$selected <- input$variable
                 }, ignoreNULL = FALSE)
             })