Question

我正在设计一个完全动态的UI，用于演示闪亮的目的。我的清单上有几个步骤，我正在一个接一个地工作。

自定义功能生成的多选框的背景颜色＆＃39; checkboxGroupInput＆＃39;
使复选框更具动态性 - 当选择/取消选择一个复选框时，背景颜色将打开/关闭

我在另一篇文章中得到了解决方案，它完美无缺。（how to make the checkboxgroupinput color-coded in Shiny）这是我得到的代码：

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))
    }
  )

现在，我想要更动态的东西 - 而不是永久地为选择分配颜色，我更喜欢为N选择的项目分配前N种颜色。不幸的是，我定制的代码不能按我想要的方式工作。

例如，我有6种颜色，并且默认情况下选择了所有六个变量，当我取消选中（二，三，四，五）中的任何一个时，我认为取消选中后的颜色会更新正常。让我们说（＆＃39; blue＆＃39;＆＃39; red＆＃39;＆＃39; green＆＃39;，＆＃39; purple＆＃39;，＆＃39;柠檬＆＃39;棕色＆＃39;）和（＆＃39;一个＆＃39;，＆＃39;两个＆＃39;三个＆＃39;，＆＃39; 4＆＃39;＆＃39; 5＆＃39;＆＃39;六＆＃39）;当我取消选中“三个”时，我想看到（＆＃39;蓝色＆＃39;，＆＃39;红色＆＃39;，＆＃39;绿色＆＃39;，＆＃ 39;紫色＆＃39;柠檬＆＃39;） for（＆＃39; one＆＃39;，＆＃39; two＆＃39;＆＃39;＆＃39; 4＆＃39;＆＃39;五，＆＃39;六＆＃39;），但实际颜色是（＆＃39;蓝色＆＃39;，＆＃39;红色＆＃39;＆＃39;紫色＆＃39;，＆＃39;柠檬＆＃39;＆＃39;蓝色＆＃39;。）

这是我用于测试的代码：

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)
        observeEvent(input$variable,{my$selected <- input$variable})
        output$my_cbgi <- renderUI(my_checkboxGroupInput("variable", "Variable:",
                                                         choices = my_names, 
                                                         selected=my$selected,
                                                         colors=my_colors[1:length(my$selected)]))
      })

Answer 1

这是该功能的更新版本，可以为您提供预期的结果。它使用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)
         })

闪亮的checkboxgroupinput动态背景颜色控制

1 个答案: