Выберите подмножество checkBoxGroupInputs из двух конфликтующих входов верхнего уровня

Question

Я хотел бы подмножать набор опций (состояний) флажков на основе двух входов верхнего уровня, один «выбрать все» и другой выбор по подмножествам (регионам). Проблема в том, что я хотел бы, чтобы Region1 был выбран заранее, но не нашел способа показать его состояния из-за конфликта с обновлением selectall. Я также не хочу, чтобы объединил вход «выбрать все» с подмножеством из-за эстетических соображений.

library(shiny) 
regions <- read.table(text=" 
region states 
Region1 A,B,C,D,E 
Region2 F,G,H,I,J 
Region3 K,L,M 
Region4 N,O,P 
Region5 Q,R,S,T 
Region6 U,V,W,X,Y,Z" , header=TRUE, stringsAsFactors=FALSE) 
regions$region<-as.factor(regions$region) 

examplesubset<-read.table(text=" 
species states 
speciesOne A,M,P,A,R,T 
speciesTwo A,B,C,M,P,E,I,N,S 
speciesThree G,M,T,F" , header=TRUE, stringsAsFactors=FALSE) 
examplesubset$species<-as.factor(examplesubset$species) 

ui<-fluidPage( 
    tags$head(tags$style(HTML(" 
           .multicol { 

            -webkit-column-count: 3; /* Chrome, Safari, Opera */ 
            -moz-column-count: 3; /* Firefox */ 
            column-count: 3; 
            -moz-column-fill: auto; 
            -column-fill: auto; 
           } 
           .multicol2 { 

            -webkit-column-count: 2; /* Chrome, Safari, Opera */ 
            -moz-column-count: 2; /* Firefox */ 
            column-count: 2; 
            -moz-column-fill: auto; 
            -column-fill: auto; 
           } 
           "))), 
titlePanel("Panel"), 
sidebarLayout(  
    sidebarPanel(
     selectInput("species", "Select species:", 
        choices=examplesubset$species) 
    ) , 
    mainPanel(
     fluidRow(
     column(3, 
     uiOutput("checkboxesui"), 
     uiOutput("checkboxesuiall"), 
     uiOutput("checkboxesuiregion") 
    )))) 
) 

server<-function(input, output,session) { 
    speciesfromselectedgenus<-reactive({ 
    sp<-examplesubset[examplesubset$species==input$species,]#" 
    sp<-droplevels(sp) 
}) 
statesfromspeciesfromselectedgenus<- reactive({ 
    j<-as.factor(unique(unlist(strsplit(speciesfromselectedgenus()$states, ",", fixed = TRUE)))) 
    j<-droplevels(j) 
    }) 
    output$checkboxesui<-renderUI({ 
    tags$div(align = 'left', 
      class = 'multicol', 
      checkboxGroupInput("statescheckboxes", "States", 
           choices=levels(statesfromspeciesfromselectedgenus()) 
           , selected=unlist(strsplit(selectedregion()$states, ",")) 
      )) 
    }) 

    output$checkboxesuiall<-renderUI({ 
    checkboxInput("allcheckboxes", "Select all", FALSE) 
    }) 


    output$checkboxesuiregion<-renderUI({ 
    tags$div(align = 'left', 
      class = 'multicol2', 
      checkboxGroupInput("regionscheckboxes", "Regions", 
             choices=levels(regions$region) 
             , selected="Region1" 
      ) 
    ) 
    }) 

    selectedregion<-reactive({ 
    sel<- regions[which(regions$region %in% input$regionscheckboxes),] 
    }) 

    observeEvent(input$allcheckboxes,{ 
    if(input$allcheckboxes == TRUE) 
    { 
     updateCheckboxGroupInput(session, "regionscheckboxes", "Regions", 
           choices=levels(regions$region) 
           , selected=levels(regions$region) 
    ) 
    } 
    else 
    { 
     updateCheckboxGroupInput(session, "regionscheckboxes", "Regions", 
           choices=levels(regions$region) 
           , selected=c() 
    ) 
    } 
    }) 

} 
shinyApp(ui = ui, server = server) 

Answer 1

Вы можете использовать логическое значение, чтобы заявить, что это первый раз, когда вы получаете в коде:

server<-function(input, output,session) { 
    firsttime<<- TRUE 
    ... 
    observeEvent(input$allcheckboxes,{ 
    if(input$allcheckboxes == TRUE) 
    { 
     updateCheckboxGroupInput(session, "regionscheckboxes", "Regions", 
           choices=levels(regions$region) 
           , selected=levels(regions$region)#"Cerrado"#levels(regions$region) 
    ) 
    } 
    else 
    { 
     if(firsttime) 
     updateCheckboxGroupInput(session, "regionscheckboxes", "Regions", 
           choices=levels(regions$region) 
           , selected="Region1" 
           ) 
     else 
     updateCheckboxGroupInput(session, "regionscheckboxes", "Regions", 
           choices=levels(regions$region) 
     ) 
     firsttime <<- FALSE 
    } 
    }) 
}