从两个冲突的上层输入中选择checkBoxGroupInputs的子集

Question

我想根据两个上层输入设置一组复选框选项(状态)，一个是“全选”，另一个是按子集(区域)选择。问题是我想要预先选择Region1，但还没有找到一种方法来显示它的状态，因为与选择的更新冲突。出于美学原因，我也不想将“全选”输入与子集输入合并。

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