如何解决通过闪亮的 R 中的动态相关输入过滤器在 GGplot 上绘制正确的百分比标签
我正在尝试在 ggplot 上绘制百分比标签，该标签根据相互依赖的 3 个用户输入呈现。 最后提供了我的代码/示例数据集。
到目前为止我已经能够实现的目标。
在本图中，百分比被划分为多个输入/输出 TAT %，因为特定周有多个输入/输出 TAT 值，我们能否将特定周的输入 TAT 和输出 TAT % 合并为一个
最后，第三个过滤器坏了，当只选择一个过滤器而不是“全部”时，它会显示此错误“错误：'closure'类型的对象不可子集化”，
代码：
library(plotly)
library(ggplot2)
library(dplyr)
library(reshape2)
library(gtools)
# plot1 <- df
plot1 <- read.csv("plot1.csv",sep = ",",header = TRUE)
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",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 <- data[data$Movement_Type %in% input$mov_type,]
}
tmp <- data %>%
group_by(Week) %>%
mutate(Quantity = sum(Quantity)) %>% distinct(Week,f_TAT,Movement_Type,Quantity) %>%
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)
数据集：
Week Region Movement_Type Warehouse f_TAT Quantity
march - 01 - march - 07 north Inter-Region FC9 In TAT 125
march - 01 - march - 07 north Inter-Region FC9 Out TAT 125
march - 01 - march - 07 north Inter-Region FC13 In TAT 5
march - 01 - march - 07 north Inter-Region FC19 In TAT 8700
march - 01 - march - 07 north Same-Region FC8 In TAT 1535
march - 01 - march - 07 north Same-Region FC9 In TAT 355
march - 01 - march - 07 north Same-Region FC10 In TAT 90
march - 01 - march - 07 north Same-Region FC12 In TAT 10
解决方法
试试这个
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))))),column(6,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({
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,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)
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
