0

編集: サンプル データを追加します。

複数の SelectInputs に「すべて選択」オプションを含めたいと思います。したがって、「すべて」の国を選択すると、2 番目の selectInput ドロップダウンにすべての地域が表示され、特定の国を選択すると、その国の「すべて」の地域または特定の地域を選択できます。

国レベルですべての作品を選択しますが、それを 2 番目の地域レベルに適用する方法がわかりません。

可能であれば、pickerInPut なしでこれを行いたいと思います。

データ：

   Country <-  c('England', 'Scotland', 'Wales', 'Ireland', 'Spain', 'England', 'Scotland', 'Wales', 'Ireland', 'Spain', 'England', 'Scotland', 'Wales', 'Ireland', 'Spain' , 'England', 'Scotland', 'Wales', 'Ireland', 'Spain')
    
    Region  <- c('North' , 'East', 'South', 'South', 'North' , 'South', 'East', 'North' , 'South', 'West', 'North' , 'South' , 'North' , 'West', 'North' , 'West', 'West', 'East', 'East', 'South')
    
    Value   <- c(100, 150, 400, 300, 100, 150, 300, 200, 500, 600, 300, 200, 250, 300, 100, 150, 300, 200, 500, 600)
    
    Outcomes <- c('Green', 'Red','' , 'Amber', 'Green', 'Green', 'Red','' , 'Red', 'Amber', 'Red', 'Green', 'Green', 'Green','' ,'' , 'Amber', 'Amber', 'Red', 'Red')
    
    Outputs <- c('Red', 'Green', 'Green', 'Green', '','' , 'Amber', 'Green', 'Red','' , 'Red', 'Amber', 'Red', 'Green', 'Green', '','' , 'Amber', 'Amber', 'Red')
    
    Risk <- c('Green', 'Green', 'Red', 'Red','' , 'Amber', 'Green', 'Green', 'Amber','' , 'Green', 'Red', 'Amber', 'Green', 'Green', 'Red', '', 'Red', 'Amber', '')
    
    
    Joined_data <- data.frame(Country, Region, Value, Outcomes, Outputs, Risk)

list<- unique(Joined_data$Country)
list2 <- unique(Joined_data$`Region`)

UI:

ui<- dashboardPage(
  dashboardHeader(title = "Performance"),
  

  dashboardSidebar(selectizeInput(inputId = "Country", label = "Country", choices = c('All', list)),
                  (selectizeInput(inputId = "Region", label = "Region", choices = c('All', list2)))),
  
 
  dashboardBody( 
    fluidRow(
      box(valueBoxOutput(outputId = "Total", width = 12), title = "Total"),
      box(valueBoxOutput(outputId = "Value", width = 12), title = "Value"),     

      
    )
  ),

)

サーバ：

server <- function(input, output, session) { 
  
Test <- reactive({
  if(input$Country == 'All') {
    Joined_data  %>% 
      filter(`Contract Locality` == input$Locality)
  } else {
  Joined_data %>%
    filter(`Country` == input$Country, `Region` == input$Region)
  
}})
  


  output$Total <- renderValueBox({
  
   valueBox(Test() %>%
      tally(), 
    
    req(input$Country)
    
  })
  

  output$Value <- renderValueBox({

    valueBox(Test() %>%
               summarise("Annualised_Value" = sum(`Value (Annualised)`)) %>%
               prettyNum(big.mark = ","), 
             
             req(input$Country)
    
  })


  Country.choice <- reactive({
    Joined_data %>% 
      filter(Country == input$Country %>%
      pull(Region)
  })
  
  observe({
    
    updateSelectizeInput(session, "Region", choices = Country.choice())
    
  })
  }

shiny::shinyApp(ui=ui,server=server)
4

1 に答える 1

1

以下の例に示すように、おそらくpickerInputあなたのニーズを満たすでしょう。

ui = fluidPage(
  titlePanel(title=div(img(src="YBS.png", height = 140, width = 140), "This is a Test")),
  sidebarLayout(
    sidebarPanel(
      uiOutput("organt"),
      uiOutput("cellt")
    ),
    mainPanel(
      tableOutput("MegaData")
    )
  )
)


server = function(input, output, session) {
  
  df1 <- veteran
  MegaP <- df1 %>% mutate(Organ=ifelse(trt==1,"Lung","Skin"))
  
  output$organt <- renderUI({
    selectInput("OrganT",
                label = "Organ",
                choices = unique(MegaP$Organ),
                multiple = T,
                selected = "All")
  })
  
  MegaP1 <- reactive({
    data <- subset(MegaP, Organ %in% req(input$OrganT))
  })
  
  output$cellt <- renderUI({
    req(MegaP1())
    mychoices <- as.character(unique(MegaP1()$celltype))
    pickerInput(inputId = "Cell",
                label = "Cell Line",
                choices = mychoices,
                multiple = TRUE, 
                options = list(`actions-box` = TRUE)
                )
  })
  
  selectedData <- reactive({
    req(MegaP1(),input$Cell)
    data <- subset(MegaP1(), celltype %in% input$Cell)
  })
  
  output$MegaData = renderTable({
    selectedData()
  })
  
}

shinyApp(ui = ui, server = server)

編集：

pickerInput を使用せずにこれを行うには、以下を試すことができます。

dat <- data.frame(Country, Region, Value, Outcomes, Outputs, Risk)

list<- unique(dat$Country)
list2 <- unique(dat$`Region`)

app <- shinyApp(
  ui = shinyUI(
    pageWithSidebar(
      headerPanel("Simple Test"),
      sidebarPanel(
        selectInput("cy", "Country", choices = c("All", list )),
        selectInput("rg", "Region", choices = c("All", list2 ))
      ),
      mainPanel(
        DTOutput("out")
      )
    )
  ),
  server = function(input, output, session) {
    filtered <- reactive({
      rows <- (input$cy == "All" | dat$Country == input$cy) &
        (input$rg == "All" | dat$Region == input$rg)
      dat[rows,,drop = FALSE]
    })
    output$out <- renderDT(filtered())
  }
)
于 2020-11-02T18:31:15.993 に答える