在 ShinyR Dashboard 中为 ggplot2 创建动态相关输入过滤器并相应地渲染图

如何解决在 ShinyR Dashboard 中为 ggplot2 创建动态相关输入过滤器并相应地渲染图

我正在尝试创建一个根据 3 个用户输入呈现的 ggplot，该输入应该相互依赖。

我的数据集如下所示：

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',as.character(unique(plot1$Region))))),selectInput('mov_type','Select Movement Type',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 的多个 % 原因是有多个特定周的输入/输出 TAT 值。我们可以尝试显示一周的整体百分比而不是多个 In TAT/Out TAT % 吗？那将解决我最后剩下的问题。再次感谢你的帮助。

编辑 2：嗨，YBS，感谢您的更新。最终的输出现在看起来像这样。

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

解决方法

您需要使用 updateSelectInput() 来更新后续 selectInput 的值。那么您只需要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,Out TAT,5
April 05 - April 11,East,13
April 05 - April 11,6
March 01 - March 07,West,Inter-State,XYZ,15
March 01 - March 07,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',as.character(unique(plot1$Region))))),checkboxGroupInput("mov_type","Select Movement Type",inline = TRUE,choices = c("All",unique(plot1$Movement_Type)))),#column(3,selectInput('mov_type','Select Movement Type',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",unique(df2$Movement_Type)) )
    updateCheckboxGroupInput(session,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,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)