R Shiny中geom_col的plotOutput日期轴点击事件异常问题

问题原因 #

在Shiny中用geom_col绘制日期x轴的柱状图时，日期会被ggplot转换为自1970-01-01以来的天数数值。默认每个柱子宽度为0.9天，因此单根柱子的覆盖范围是日期数值 - 0.45到日期数值 + 0.45。直接将点击返回的input$click$x转换为日期时，若点击位置靠近柱子左侧（落在前一个日期的数值区间内），就会得到错误的日期。

解决方法 #

通过预计算每个柱子的数值区间，判断点击位置落在哪个区间内，从而匹配到正确的日期。这种方法不受点击位置影响，且适配自定义柱子宽度的场景。

修改后的完整代码：

library(shiny)
library(dplyr)
library(lubridate)
library(ggplot2)

dat <- tibble(
    x = as.Date(c("2022-01-01", "2022-01-02")),
    y = 1:2
)

ui <- fluidPage(
    plotOutput("plt", click = "click"),
    textOutput("click_raw"),
    textOutput("click_chr")
)

server <- function(input, output, session) {
    # 预计算每个柱子的左右边界（默认width=0.9，半宽为0.45）
    dat_bounds <- dat %>%
        mutate(
            x_num = as.numeric(x),
            left = x_num - 0.45,
            right = x_num + 0.45
        )
    
    output$plt <- renderPlot({
        dat %>%
            ggplot(aes(x, y)) +
                geom_col() # 若自定义width，需同步修改dat_bounds中的半宽值
    })
    
    output$click_raw <- renderText({
        input$click$x
    })
    
    output$click_chr <- renderText({
        if(!is.null(input$click$x)){
            # 匹配点击位置对应的柱子日期
            selected_date <- dat_bounds %>%
                filter(left <= input$click$x, input$click$x <= right) %>%
                pull(x)
            as.character(selected_date)
        } else {
            "未点击图表"
        }
    })
}

shinyApp(ui, server)

注意事项 #

如果自定义了柱子宽度（比如geom_col(width = 0.5)），需要将dat_bounds中的0.45改为width/2（即0.25），保证区间计算准确。

内容的提问来源于stack exchange，提问作者heds1