如何从 Shiny 中的过滤数据创建条形图？

Question

In this example it is always the first combination of Type and Period that is used in the barplot. No matter what combination is selected it is always Type A and Period 01 that is plotted. What I am doing wrong? I am guessing that it must be something in the renderDataTable-part in server.

A reproducible example:

packages=c(
  'shiny', 'DT', 'shinyWidgets'
)

for (p in packages){
  if (!require(p, character.only=T)){          
    install.packages(p,dependencies = T)           
  }
  library(p, character.only=T)       
}

data <- expand.grid(c("A", "B", "C", "D"), c("01", "02", "03", "04", "05", "06"))
names(data) <- c("Type", "Period")
data <- data[order(data$Type, data$Period),]
data <- cbind(data,  "1970" = sample(c(1:100), dim(data)[1], rep = T),  "1971" = sample(c(1:100), dim(data)[1], rep = T))

ui <- basicPage(
  h2("Data"),
  pickerInput("Type",
              label=div(HTML("Select type:"),style="color:darkblue"),width="auto",
              choices=c("",unique(as.character(data$Type))),
              selected="",
              multiple=FALSE,
              options = list(
                `actions-box` = TRUE,
                `none-selected-text` = "No type selected",
                `selected-text-format` = paste0("count>",length(c("",unique(as.character(data$Type))))-1)
              ),
              choicesOpt = list(
                style = rep(("color:darkgreen; background: white; font-weight: bold;"),
                            length(c(unique(as.character(data$Type))))+1)
              )
  ),
  pickerInput("Period",
              label=div(HTML("Select period:"),style="color:darkblue"),width="auto",
              choices=c("",unique(as.character(data$Period))),
              selected="",
              multiple=FALSE,
              options = list(
                `actions-box` = TRUE,
                `none-selected-text` = "No period selected",
                `selected-text-format` = paste0("count>",length(c("",unique(as.character(data$Period))))-1)
              ),
              choicesOpt = list(
                style = rep(("color:darkgreen; background: white; font-weight: bold;"),
                            length(c(unique(as.character(data$Period))))+1)
              )
  ),
  DT::dataTableOutput("mydata"),
  plotOutput('plot1')
)

server <- function(input, output, session) {
  
  data <- data
  
  output$mydata = DT::renderDataTable({
    if (input$Type != "All the types") {
      data <- data[data$Type %in%  input$Type,]
    }
    else{data}
    
    if (input$Period != "All the periods") {
      data <- data[data$Period %in%  input$Period,]
    }
    else{data}
  })
  
  filtered_table <- reactive({
    req(input$mydata_rows_all)
    data[input$mydata_rows_all, ]
  })
  
  output$plot1 <- renderPlot({
    barplot(c(t(filtered_table()[,c("1970", "1971")])),
            col = rainbow(2),
            horiz = T,
            names.arg=c("1970", "1971"))
  })
}

shinyApp(ui, server)

Answer 1

Try this code:

• Created filtered_table as reactiveValues .
• Changed the check if(input$Type != "All the types") to if (input$Type != "") since there is no Type value which is "All the types" .
• Added some checks before showing the plot.

library(shiny)
library(DT)
library(shinyWidgets)

data <- expand.grid(c("A", "B", "C", "D"), c("01", "02", "03", "04", "05", "06"))
names(data) <- c("Type", "Period")
data <- data[order(data$Type, data$Period),]
data <- cbind(data,  "1970" = sample(c(1:100), dim(data)[1], rep = T),  "1971" = sample(c(1:100), dim(data)[1], rep = T))

ui <- basicPage(
  h2("Data"),
  pickerInput("Type",
              label=div(HTML("Select type:"),style="color:darkblue"),width="auto",
              choices=c("",unique(as.character(data$Type))),
              selected="",
              multiple=FALSE,
              options = list(
                `actions-box` = TRUE,
                `none-selected-text` = "No type selected",
                `selected-text-format` = paste0("count>",length(c("",unique(as.character(data$Type))))-1)
              ),
              choicesOpt = list(
                style = rep(("color:darkgreen; background: white; font-weight: bold;"),
                            length(c(unique(as.character(data$Type))))+1)
              )
  ),
  pickerInput("Period",
              label=div(HTML("Select period:"),style="color:darkblue"),width="auto",
              choices=c("",unique(as.character(data$Period))),
              selected="",
              multiple=FALSE,
              options = list(
                `actions-box` = TRUE,
                `none-selected-text` = "No period selected",
                `selected-text-format` = paste0("count>",length(c("",unique(as.character(data$Period))))-1)
              ),
              choicesOpt = list(
                style = rep(("color:darkgreen; background: white; font-weight: bold;"),
                            length(c(unique(as.character(data$Period))))+1)
              )
  ),
  DT::dataTableOutput("mydata"),
  plotOutput('plot1')
)

server <- function(input, output, session) {
  
  filtered_table <- reactiveValues(data = NULL)
  
  output$mydata = DT::renderDataTable({
    if (input$Type != "") {
      data <- data[data$Type %in%  input$Type,]
    }
    else{data}
    
    if (input$Period != "") {
      data <- data[data$Period %in%  input$Period,]
    }
    else{data}
    
    filtered_table$data <- data
  })
  
  
  
  output$plot1 <- renderPlot({
    req(filtered_table$data, input$Type, input$Period)
    barplot(c(t(filtered_table$data[,c("1970", "1971")])),
            col = rainbow(2),
            horiz = T,
            names.arg=c("1970", "1971"))
  })
}

shinyApp(ui, server)