r - 在 Shiny 的 R 仪表板中为 ggplot2 创建动态相关输入过滤器并相应地渲染图

Question

我正在尝试创建一个 ggplot，它根据 3 个用户输入呈现，它们应该相互依赖。
我的数据集如下所示:

Week                  Region   Movement_Type    Warehouse  f_TAT     Quantity 
April 05 - April 11   North    Local            ABC        In TAT    10
April 05 - April 11   North    Local            ABC        Out TAT   5
April 05 - April 11   East     Local            ABC        In TAT    13
April 05 - April 11   East     Local            ABC        Out TAT   6
March 01 - March 07   West     Inter-State      XYZ        In TAT    15
March 01 - March 07   West     Inter-State      XYZ        Out TAT   10

到目前为止我已经能够实现的目标:
我已经能够用 3 个过滤器创建 ggplot，它们现在不相互依赖。当没有选择特定过滤器时，它默认显示所有选项。但它正在绘制错误的情节

当我选择仓库过滤器和区域过滤器时，数据似乎发生了变化，但仍然显示错误的图。

我的代码帮助我实现了这一目标:

    library(plotly)
library(ggplot2)
library(dplyr)
library(reshape2)
library(gtools)

ui <- shinyUI(
  
  navbarPage(
    title = 'Dashboard',
    
    tabPanel('Performance',
             tabsetPanel(
               tabPanel('Tab1',
                        fluidRow(
                          column(3,selectInput('warehouse', 'Select Warehouse', c("All",as.character(unique(plot1$Warehouse))))), 
                          column(3,selectInput('region', 'Select Region', c("All",as.character(unique(plot1$Region))))),
                          column(3,selectInput('mov_type', 'Select Movement Type', c("All",as.character(unique(plot1$Movement_Type))))),
                          column(12,plotlyOutput("myplot_fwd_f"))
                        )
               )
             )),
    
    
    tabPanel('Orders',
             fluidRow(
             )
    )
  )
  
  
  
)


server <- function(input, output) {
  
  data1 <- reactive({
    plot1 <- read.csv("plot1.csv", sep = ",", header = TRUE)
    temp <- plot1
    if (input$warehouse != "All"){
      temp <- temp[temp$Warehouse == input$warehouse,]
    }
    if (input$region != "All"){
      temp <- temp[temp$Region == input$region,]
    }
    if (input$mov_type != "All"){
      temp <- temp[temp$Movement_Type == input$mov_type,]
    }
    return(temp)
  })

  output$myplot_fwd_f <- renderPlotly({

    data <- data1()
    p<- ggplot(data, aes(fill=f_TAT, y=Quantity , x=reorder(Week, + Week))) + 
      geom_bar(position="fill", stat="identity",colour="black") + scale_fill_manual(values=c("#44E62F", "#EC7038")) +
      labs(x = "Week") +
      labs(y = "Percentage") +
      labs(title = "") +
      scale_y_continuous(labels=scales::percent) +
      geom_text(data = . %>%
                  group_by(Warehouse,Region,Movement_Type,Week) %>%
                  mutate(p = Quantity  / sum(Quantity )) %>%
                  ungroup(),
                aes(y = p, label = scales::percent(p)),
                position = position_stack(vjust = 0.5),
                show.legend = FALSE) +
      theme(axis.text.x = element_text(angle = 10))
    p <- ggplotly(p, tooltip="text")
    p
    
  })
  

}

shinyApp(ui, server)

我想知道是否有办法让 3 个过滤器相互依赖？截至目前，它们显示了它们可以在数据库的特定列中找到的所有唯一值。
默认情况下，当所有三个过滤器都选择了“全部”选项时，它们似乎在绘图上绘制了所有可能的组合，如何纠正这种情况。
最后，我可以将第三个“移动类型”过滤器更改为多复选框选项过滤器吗？
谢谢你。
编辑:非常感谢@YBS 我能够实现依赖过滤器的所有感谢你..@YBS 根据你在下面的评论中所述，它显示 In TAT/Out Tat 的多个 % 原因是 In 有多个值/Out TAT 特定一周。我们可以尝试显示一周的整体百分比而不是多个 In TAT/Out TAT % 吗？那将解决我最后剩下的问题。再次感谢你的帮助。
编辑 2:嗨，YBS，感谢您的更新。最终的输出现在看起来像这样。

似乎它仍在将其划分为不同的级别，有没有办法在一周内仅显示 1% 的 In/Out TAT。一件事我还注意到，当仅选择一个过滤器而不是所有过滤器时，第三个过滤器会显示此错误“错误:'关闭'类型的对象不是子集化的”，即使应用了过滤器的数据集。我是否需要扩展数据集以便您更好地理解？

Answer 1

您需要使用 updateSelectInput()更新后续 selectInput 的值s。那么你需要group_by只有Week .为了每周汇总一些数据，需要进行一些数据处理。也许这可以满足您的需求。

df <- read.table(text=
"Week,                Region,   Movement_Type,    Warehouse,  f_TAT,     Quantity
April 05 - April 11,   North,    Local,            ABC,        In TAT,    10
April 05 - April 11,   North,    Local,            ABC,        Out TAT,   5
April 05 - April 11,   East,    Local,            ABC,        In TAT,    13
April 05 - April 11,   East,    Local,            ABC,        Out TAT,   6
March 01 - March 07,   West,     Inter-State,      XYZ,        In TAT,    15
March 01 - March 07,   West,     Inter-State,      XYZ,        Out TAT,   10", header=TRUE, sep=",")

library(plotly)
library(ggplot2)
library(dplyr)
library(reshape2)
library(gtools)

plot1 <- df

ui <- shinyUI(

  navbarPage(
    title = 'Dashboard',

    tabPanel('Performance',
             tabsetPanel(
               tabPanel('Tab1',
                        fluidRow(
                          column(3,selectInput('warehouse', 'Select Warehouse', c("All",as.character(unique(plot1$Warehouse))))),
                          column(3,selectInput('region', 'Select Region', c("All",as.character(unique(plot1$Region))))),
                          column(3,checkboxGroupInput("mov_type","Select Movement Type", inline = TRUE, choices = c("All",unique(plot1$Movement_Type)))),
                          #column(3,selectInput('mov_type', 'Select Movement Type', c("All",as.character(unique(plot1$Movement_Type))))),
                          column(12,plotlyOutput("myplot_fwd_f"))
                        )
               )
             )),


    tabPanel('Orders',
             fluidRow( DTOutput("t1")
             )
    )
  )

)


server <- function(input, output, session) {

  data1 <- reactive({
    plot1 <- df # read.csv("plot1.csv", sep = ",", header = TRUE)
    temp <- plot1
    if (input$warehouse != "All"){
      temp <- temp[temp$Warehouse == input$warehouse,]
    }
    return(temp)
  })

  observeEvent(input$warehouse, {
    df1 <- data1()
    updateSelectInput(session,"region",choices=c("All",as.character(unique(df1$Region))))
  })

  data2 <- reactive({
    req(input$region)
    plot1 <- data1()
    temp <- plot1
    if (input$region != "All"){
      temp <- temp[temp$Region == input$region,]
    }
    tmp <- temp %>%
      group_by(Week) %>%
      mutate(p = Quantity  / sum(Quantity )) %>%
      ungroup()
    return(tmp)
  })

  observeEvent(input$region, {
    df2 <- req(data2())
    #updateSelectInput(session,"mov_type",choices=c("All",unique(df2$Movement_Type)) )
    updateCheckboxGroupInput(session,"mov_type",choices=c("All",as.character(unique(df2$Movement_Type))), inline=TRUE, selected="All")
  })
  
  data3 <- reactive({
    req(input$mov_type)
    if ("All" %in% input$mov_type){ 
      data <- data2()
    }else{
      data <- data2()[data2()$Movement_Type %in% input$mov_type,]
    }
    tmp <- data %>%
      group_by(Week,f_TAT) %>%
      mutate(Quantity = sum(Quantity)) %>% distinct(Week,f_TAT,Quantity) %>% 
      group_by(Week) %>% 
      mutate(p = Quantity  / sum(Quantity )) %>%
      ungroup()
    return(tmp)
  })

  output$t1 <- renderDT(data3())

  output$myplot_fwd_f <- renderPlotly({
    
    data <- req(data3())

    p<- ggplot(data, aes(fill=f_TAT, y=p , x=Week)) +
      geom_bar(position="fill", stat="identity",colour="black") + scale_fill_manual(values=c("#44E62F", "#EC7038")) +
      labs(x = "Week") +
      labs(y = "Percentage") +
      labs(title = "") +
      scale_y_continuous(labels=scales::percent) +
      geom_text(aes(y = p, label = scales::percent(p)),
                position = position_stack(vjust = 0.5),
                show.legend = FALSE) +
      theme(axis.text.x = element_text(angle = 10))
    p <- ggplotly(p) #, tooltip="text")
    p

  })

}

shinyApp(ui, server)