如何從 Shiny 中的過濾數據創建條形圖？

Question

在此示例中，條形圖中使用的始終是 Type 和 Period 的第一個組合。 無論選擇何種組合，始終繪制類型 A 和周期 01。 我做錯了什么？ 我猜它一定是服務器的renderDataTable-part中的東西。

一個可重現的例子：

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

試試這個代碼：

• 創建filtered_table作為reactiveValues 。
• 將檢查if(input$Type != "All the types")更改為if (input$Type != "")因為沒有Type值是"All the types" 。
• 在顯示 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)