R shiny ggplot - 如何不让年份标签超出网格？

Posted 2023-02-16

【中文标题】R shiny ggplot - 如何不让年份标签超出网格？

【英文标题】：R shiny ggplot - How not to let the year labels go beyond the grid?

【发布时间】：2021-11-12 19:34:15

【问题描述】：

我和我的朋友正在使用 ggplot 学习 R 语言。我们发现 x 轴标签超出了网格范围。

简单的数据文件在这里：https://drive.google.com/file/d/1pZQe89wxw14lirW2mRIgi9h29yPyc7Fs/view?usp=sharing

我们删除了滑动条和 x 轴中年份的小数点（使用 scale_x_discrete(limits=c(input$year[1]:input$year[2]))）

但是又出现了一个问题：为什么2020的x轴标签会超出网格？

PS：没有2020年和2021年所有项目的数据。

有两种解决方法：1.覆盖网格中的x轴标签。 2. 不允许用户在滑动条上选择没有数据的年份。

我可以知道如何为这两种方式编写代码吗？

这里是源代码：

library(shiny)
library(shinydashboard)
library(dplyr)
library(tidyverse)
library(reshape)
library(scales)



ecd <- read.csv("ecd-figures.csv")

c(
  "No of case" = "no_of_case",
  "Minor Case" = "minor_case",
  "All Non Fatal Case" = "all_non_fatal_case",
  "Fatal Case" = "fatal_case"
) -> vec

ui <- fluidPage(sidebarLayout(
  sidebarPanel
  (
    checkboxGroupInput("feature",
                       "Feature",
                       vec),
    sliderInput(
      "year",
      "Year",
      min = 2015,
      max = 2021,
      value = c(2015, 2021),
      sep = "",
      step = 1
    )
  ),
  
  mainPanel(tabsetPanel(
    tabPanel("Plot", plotOutput("correlation_plot")),
    tabPanel("Table", tableOutput("ecd"))
  ))
))



server <- function(input, output) 
  yearrange <- reactive(
    ecd %>% subset(year %in% input$year[1]:input$year[2]) %>% select(c(year, input$feature))
  )
  
  output$correlation_plot <- renderPlot(
    
    ecdsubset <- yearrange()
    ecdsubset <- melt(ecdsubset, id = "year")
    validate(need(input$feature, 'Check at least one item.'))
    ggplot(ecdsubset,aes(x=year,y=value,color=variable))+geom_line(size=1)+
      scale_x_discrete(limits=c(input$year[1]:input$year[2]))
    
  )
  output$ecd <- renderTable(
    yearrange()
  )
  


shinyApp(ui, server)

这是输出。

非常感谢。

【参考方案1】：

对于 1) 删除 scale_x_discrete。

对于 2) 您可以从数据中获取这些值，而不是硬编码 min、max 和 value。

library(shiny)
library(shinydashboard)
library(dplyr)
library(tidyverse)
library(reshape)
library(scales)


ecd <- read.csv("ecd-figures.csv")

c(
  "No of case" = "no_of_case",
  "Minor Case" = "minor_case",
  "All Non Fatal Case" = "all_non_fatal_case",
  "Fatal Case" = "fatal_case"
) -> vec

ui <- fluidPage(sidebarLayout(
  sidebarPanel
  (
    checkboxGroupInput("feature",
                       "Feature",
                       vec),
    sliderInput(
      "year",
      "Year",
      min = min(ecd$year),
      max = max(ecd$year),
      value = range(ecd$year),
      sep = "",
      step = 1
    )
  ),
  
  mainPanel(tabsetPanel(
    tabPanel("Plot", plotOutput("correlation_plot")),
    tabPanel("Table", tableOutput("ecd"))
  ))
))



server <- function(input, output) 
  yearrange <- reactive(
    ecd %>% subset(year %in% input$year[1]:input$year[2]) %>% select(c(year, input$feature))
  )
  
  output$correlation_plot <- renderPlot(
    
    ecdsubset <- yearrange()
    ecdsubset <- melt(ecdsubset, id = "year")
    validate(need(input$feature, 'Check at least one item.'))
    ggplot(ecdsubset,aes(x=year,y=value,color=variable))+geom_line(size=1)
    
  )
  output$ecd <- renderTable(
    yearrange()
  )
  


shinyApp(ui, server)

【讨论】：

for 1)，问题是，如果我使用scale_x_continuous，小数点会重新出现.....例如2015.00、2015.25、2015.50、2015.75、2016.00。毫无意义。

我没有使用我的代码得到小数。也许您想将year 更改为因子？

应该是这个？ validate(need(input$feature, 'Check at least one item.')) ecd$year <- as.factor(ecd$year) ggplot(ecdsubset,aes(x=year,y=value,color=variable))+geom_line(size=1)+ scale_x_continuous(limits=c(input$year[1]:input$year[2])) 失败了.....

我已经更新了答案并添加了一张图片来展示我的结局。

嗯.....但是一旦我选择了一个更窄的范围，比如 2016 年到 2017 年，年份标签就是十进制形式，如下所示：drive.google.com/file/d/1MleXuwpQPAcNiBuNpFCxg3Bi23milYy2/…

【参考方案2】：

除了 Ronak Shah 的回答之外，将此代码放到服务器部分 yeararrange

 mutate(across(where(is.numeric), as.integer)) %>% 

完整代码：

library(shiny)
library(shinydashboard)
library(dplyr)
library(tidyverse)
library(reshape)
library(scales)

ecd <- read.csv("ecd-figures.csv")

c(
    "No of case" = "no_of_case",
    "Minor Case" = "minor_case",
    "All Non Fatal Case" = "all_non_fatal_case",
    "Fatal Case" = "fatal_case"
) -> vec

ui <- fluidPage(sidebarLayout(
    sidebarPanel
    (
        checkboxGroupInput("feature",
                           "Feature",
                           vec),
        sliderInput(
            "year",
            "Year",
            min = min(ecd$year),
            max = max(ecd$year),
            range = c(min(ecd$year), max(ecd$year)),
            sep="",
            step = 1
        )
    ),
    
    mainPanel(tabsetPanel(
        tabPanel("Plot", plotOutput("correlation_plot")),
        tabPanel("Table", tableOutput("ecd"))
    ))
))



server <- function(input, output) 
    yearrange <- reactive(
        ecd %>% 
            mutate(across(where(is.numeric), as.integer)) %>% 
            subset(year %in% input$year[1]:input$year[2]) %>% 
            select(c(year, input$feature))
    )
    
    output$correlation_plot <- renderPlot(
        
        ecdsubset <- yearrange()
        ecdsubset <- melt(ecdsubset, id = "year")
        validate(need(input$feature, 'Check at least one item.'))
        ggplot(ecdsubset,aes(x=year,y=value,color=variable))+geom_line(size=1)+
            theme(legend.position = "none") +
            scale_x_discrete(limits=c(input$year[1]:input$year[2]))
        
    )
    output$ecd <- renderTable(
        yearrange()
    )
    


shinyApp(ui, server)

【讨论】：

先谢谢你。只要使用scale_x_discrete，您的建议就会起作用。但正如 Ronak Shah 提到的，我应该更好地使用 scale_x_continuous。也正因为如此，小数点还在……drive.google.com/file/d/1MleXuwpQPAcNiBuNpFCxg3Bi23milYy2/…

【参考方案3】：

我最终采用了 Joshua Cook 的解决方案，即为标签中断编写一个额外的函数。完整代码：

library(shiny)
library(shinydashboard)
library(dplyr)
library(tidyverse)
library(reshape)
library(scales)



ecd <- read.csv("ecd-figures.csv")

c(
  "No of case" = "no_of_case",
  "Minor Case" = "minor_case",
  "All Non Fatal Case" = "all_non_fatal_case",
  "Fatal Case" = "fatal_case"
) -> vec

ui <- fluidPage(sidebarLayout(
  sidebarPanel
  (
    checkboxGroupInput("feature",
                       "Feature",
                       vec),
    sliderInput(
      "year",
      "Year",
      min = min(ecd$year),
      max = max(ecd$year),
      value = range(ecd$year),
      sep = "",
      step = 1
    )
  ),
  
  mainPanel(tabsetPanel(
    tabPanel("Plot", plotOutput("correlation_plot")),
    tabPanel("Table", tableOutput("ecd"))
  ))
))



server <- function(input, output) 
  yearrange <- reactive(
    ecd %>%
      subset(year %in% input$year[1]:input$year[2]) %>%
      select(c(year, input$feature))
  )
  
  integer_breaks <- function(n = 5, ...) 
    fxn <- function(a) 
      breaks <- floor(pretty(a, n, ...))
      names(breaks) <- attr(breaks, "labels")
      breaks
    
    return(fxn)
  
  
  
  output$correlation_plot <- renderPlot(
    ecdsubset <- yearrange()
    ecdsubset <- melt(ecdsubset, id = "year")
    validate(need(input$feature, 'Check at least one item.'))
    ggplot(ecdsubset, aes(x = year, y = value, color = variable)) + geom_line(size = 1) + scale_x_continuous(breaks = integer_breaks())
    
    
  )
  output$ecd <- renderTable(
    yearrange()
  )
  


shinyApp(ui, server)

我不明白的是，... 在integer_breaks <- function(n = 5, ...) 中是什么意思？谢谢你的建议。