问题描述
我正在尝试在ggplot上绘制百分比标签,该ggplot是根据3个彼此依赖的用户输入呈现的.最后提供了我的代码/示例数据集.
I'm trying to plot percentage labels on a ggplot that is rendered as per the 3 user input's which are dependent of each other.My Code/Example Data Set is provided at the end.
到目前为止,我已经能够实现的目标.在当前图表中,由于在特定一周内有多个InTAT/Out TAT值,该百分比被分成了多个In/Out TAT%,我们可以将其合并为一个In TAT& TAT.某周的TAT百分比
What i Have been able to achieve as of Now.In the present plot the percentage is getting divided in to Multiple In/Out TAT %'s as there are multiple values of InTAT/Out TAT for a particular week, can we consolidate into just one In TAT & Out TAT % for a particular week
最后,当仅选择一个过滤器而不是全部"过滤器时,第三过滤器坏了.它显示出此错误错误:类型为'closure'的对象不能被子集化"",
And lastly the 3rd filter is broken, when only one filter is selected instead of "All" it show's this error "Error : object of type 'closure' is not subsettable",
代码:
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', 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 <- 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', c("All",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', 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({
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)
这篇关于通过闪亮的R中依赖于动态的输入过滤器在GGplot上绘制正确的百分比标签的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!