在 shinyR 仪表板中为 ggplot2 创建动态相关输入过滤器并相应地渲染图
Creating dynamic dependent input filter for ggplot2 in shinyR Dashboard and render plot accordingly
我正在尝试创建一个 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，这些过滤器到目前为止彼此不依赖。当没有特定的过滤器被 selected 时，它默认显示所有选项。但它正在策划错误的情节
当我 select 仓库过滤器和区域过滤器时，数据似乎发生了变化，但仍然显示错误的图。
帮助我实现这一目标的代码：
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 个过滤器相互依赖？截至目前，他们显示了他们可以在数据库的特定列中找到的所有唯一值。
默认情况下，所有三个过滤器都有“全部”选项 select，它们似乎在绘图上绘制了所有可能的组合，如何更正这一点。
最后，我可以将第三个“运动类型”过滤器更改为多复选框选项过滤器吗？
谢谢。
编辑：非常感谢@YBS 多亏了你，我才能够实现依赖过滤器。@YBS 根据你在下面的评论中所述，它显示了 In TAT/Out Tat Reason 的多个 %是特定一周的 In/Out TAT 的多个值。我们可以尝试显示一周的总体百分比而不是多个 In TAT/Out TAT % 吗？那将解决我最后剩下的问题。再次感谢您的帮助。
编辑 2：您好 YBS，感谢您的更新。最终输出现在看起来像这样。
好像还是分等级的，有没有办法只显示一周的In/OutTAT的百分之一。我还注意到的一件事是，当只有一个过滤器被 selected 而不是它显示的所有过滤器时，第三个过滤器是这个错误“错误：'closure' 类型的对象不是子集”，即使有数据集对于应用的过滤器。我需要扩展数据集以便您更好地理解吗？
您需要使用updateSelectInput()更新后续selectInput的值。那么你只需要group_byWeek。要每周汇总，需要进行一些数据处理。或许这能满足您的需求。
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)
我正在尝试创建一个 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，这些过滤器到目前为止彼此不依赖。当没有特定的过滤器被 selected 时，它默认显示所有选项。但它正在策划错误的情节
当我 select 仓库过滤器和区域过滤器时，数据似乎发生了变化，但仍然显示错误的图。
帮助我实现这一目标的代码：
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 个过滤器相互依赖？截至目前，他们显示了他们可以在数据库的特定列中找到的所有唯一值。
默认情况下，所有三个过滤器都有“全部”选项 select，它们似乎在绘图上绘制了所有可能的组合，如何更正这一点。
最后，我可以将第三个“运动类型”过滤器更改为多复选框选项过滤器吗？
谢谢。
编辑：非常感谢@YBS 多亏了你，我才能够实现依赖过滤器。@YBS 根据你在下面的评论中所述，它显示了 In TAT/Out Tat Reason 的多个 %是特定一周的 In/Out TAT 的多个值。我们可以尝试显示一周的总体百分比而不是多个 In TAT/Out TAT % 吗？那将解决我最后剩下的问题。再次感谢您的帮助。
编辑 2：您好 YBS，感谢您的更新。最终输出现在看起来像这样。
好像还是分等级的，有没有办法只显示一周的In/OutTAT的百分之一。我还注意到的一件事是，当只有一个过滤器被 selected 而不是它显示的所有过滤器时，第三个过滤器是这个错误“错误：'closure' 类型的对象不是子集”，即使有数据集对于应用的过滤器。我需要扩展数据集以便您更好地理解吗？
您需要使用updateSelectInput()更新后续selectInput的值。那么你只需要group_byWeek。要每周汇总，需要进行一些数据处理。或许这能满足您的需求。
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)