通过闪亮的 R 中的动态相关输入过滤器在 GGplot 上绘制正确的百分比标签

退休声学

我正在尝试在 ggplot 上绘制百分比标签,该标签根据相互依赖的 3 个用户输入呈现。最后提供了我的代码/示例数据集。

到目前为止我已经能够实现的目标。在本图中,百分比被划分为多个输入/输出 TAT %,因为特定周有多个输入/输出 TAT 值,我们能否将特定周的输入 TAT 和输出 TAT % 合并为一个在此处输入图片说明

最后,第三个过滤器坏了,当只选择一个过滤器而不是“全部”时,它显示了这个错误“错误:‘闭包’类型的对象不是子集化的”,

在此处输入图片说明

代码:

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
YBS

试试这个

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)

输出

本文收集自互联网,转载请注明来源。

如有侵权,请联系 [email protected] 删除。

编辑于
0

我来说两句

0 条评论
登录 后参与评论

相关文章

在显示百分比的r中绘制一个混淆矩阵(ggplot)

更改R ggplot中的直方图条百分比标签

r在直方图ggplot中按bin的百分比

R ggplot中因子水平的绘图百分比

通过计算 R 中两列值之间的百分比值,在条形图标签上添加百分比符号标签

带百分比的R ggplot

以块为单位绘制R中的百分比

堆叠的ggplot百分比条形图在闪亮

在R中的饼图上添加百分比标签

ggplot2中条形图的计数和百分比如何?[R

如何使用ggplot在R中创建分组百分比图?

获取ggplot2图例以在R中显示百分比符号

使用ggplot在R中创建堆积百分比条形图

R:使用ggplot2将百分比作为标签的饼图

闪亮输入中的相关过滤器

在ggplot2中的条之间绘制百分比线

如何将百分比标签移到 ggplot2 中的饼图之外?

如何在ggplot geom_text标签中添加百分比和分数?

ggplot2 中多面填充条形图中的标签百分比

在 ggplot 2 中为两个离散变量创建百分比标签

在ggplot中编辑悬停标签文本以显示百分比

R中的累积百分比

如何在R中的ggplot2中向条形图方面添加百分比?

用 R ggplot2 中的百分比从头开始分类变量的堆叠条形图

如何在R中的计数ggplot条形图中添加一个变量的百分比

R 或 Python 中是否有可以单独计算多选 Tableau 过滤器的份额百分比的函数?

R:ggplot堆叠的条形图,y轴上有计数,但百分比为标签

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

绘制区域的斜率并在 R 中返回高于和低于阈值的百分比