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

问题描述：

我想根据两个上层输入来子集一组复选框选项（状态），一个“全选”和另一个子集（区域）选择。问题是我想要预先选择Region1，但还没有找到显示其状态的方法，因为与selectall更新有冲突。由于审美原因，我也不希望将“全选”输入与子集输入合并。从两个冲突的上层输入中选择checkBoxGroupInputs的子集

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)

答

您可以使用一个布尔值来说明这是你第一次在代码中得到：

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

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

相关推荐