блестящий checkboxgroupinput динамический контроль цвета backgroud

Question

Я разрабатываю полностью динамический интерфейс для демонстрации с блестящим. В моем списке несколько шагов, я работаю один за другим.

1. сделать настройки цвета фона в многовариантных боксов, генерируемых с помощью функции «checkboxGroupInput»
2. сделать флажками более динамичным - когда цвет фона будет вкл/выкл, когда выберите/отмените выбор один checkbox

Я получил решение в другом посте, и он отлично работает. (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 цветов, и у меня есть все шесть переменных, выбранных по умолчанию, когда я отменю один из (два, три, четыре, пять), я предполагаю, что цветные после снятого правильно обновить. скажем, («синий», «красный», «зеленый», «фиолетовый», «лимон», «коричневый») И («один», «два», «три», «четыре», «пять» ',' six '); когда я де-проверю «три», я хочу увидеть («синий», «красный», «зеленый», «фиолетовый», «лимон») для («один», «два», «четыре», пять ',' шесть '), но фактический цвет (' синий ',' красный ',' фиолетовый ',' лимон ',' синий ').

вот код, который я использовал для тестирования:

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

Вот обновленная версия функции, которая даст вам ожидаемый результат. Он использует параметр 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) 
     })