闪亮的复选框组输入动态背景颜色控件 [英] shiny checkboxgroupinput dynamic background color control

问题描述

我正在设计一个完全动态的UI，以进行具有光泽的演示。我的清单上有几个步骤，我一个接一个地工作。

I am designing a fully dynamic UI for the purpose of demonstration with shiny. There are a few steps on my list, I am working on one after another.

1. 自定义多项选择的背景颜色函数'checkboxGroupInput'生成的框


2. 使复选框更具动态性-选择/取消选择一个复选框时打开/关闭背景色

我在另一篇文章中找到了解决方案，它运行良好。 （如何使checkboxgroupinput用Shiny进行颜色编码）这是我得到的代码：

I got the solution in another post, and it works perfectly. (how to make the checkboxgroupinput color-coded in Shiny) Here is the code I got:

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个所选项目。不幸的是，我自定义的代码无法按照我想要的方式工作。

Now, I wanna things more dynamic -- instead of assigning a color to a choice permanently, I prefer assigning first N colors to the N chosen item. Unfortunately, the code I customized does not work the way I want.

例如，我有6种颜色，并且在我取消检查（两个，三个，四个，五个）中的任何一个，我认为取消选中后的颜色会正确更新。假设（'蓝色'，'红色'，'绿色'，'紫色'，'柠檬'，'棕色'）和（'一个'，'两个'，'三个' ，四个，五个，六个）；当我取消选中三时，我想看到（蓝色，红色，绿色，紫色，柠檬）为（一，两个， （蓝色，红色，紫色，柠檬，蓝色）。

For example, I have 6 colors, and have all six variables chosen by default, when I de-check any one of (two, three, four, five), I assume the color ones after the de-checked will update properly. let's say ('blue','red','green','purple','lemon','brown') AND ('one','two','three','four','five','six'); when I de-check 'three', I wanna see ('blue','red','green','purple','lemon') for ('one','two','four','five','six'), but the actual color is ('blue','red','purple','lemon','blue').

这是我用于测试的代码：

here is the code I used for testing:

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

推荐答案

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

Here is an updated version of the function that will give you expected result. It uses the ignoreNULL parameter of observeEvent to track the unchecking of last checked box. I had to add a variable to ignore the first call that would unselect all your initial selection:

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

这篇关于闪亮的复选框组输入动态背景颜色控件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！