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

RavenR 发表于 Dev

乌鸦

在此示例中，条形图中始终使用“类型”和“期间”的第一个组合。无论选择哪种组合，始终会绘制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)

罗纳克·沙

试试这个代码：

创建filtered_table为reactiveValues。
将检查更改为if(input$Type != "All the types")，if (input$Type != "")因为没有Type值"All the types"。
在显示图之前添加了一些检查。

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)

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。