求助：Shiny应用中R绘制的图表无法显示的问题排查

我仔细看了你的Shiny应用代码，发现好几个关键问题导致图表没法正常显示，咱们一个个来修正：

1. 图表渲染函数不匹配（核心问题） #

你在server里用renderPrint()来对应UI里的plotOutput("plot")，这俩完全不搭！plotOutput()需要搭配renderPlot()才能正确渲染ggplot（或者基础绘图）的结果，而renderPrint()是用来输出文本内容的，对应verbatimTextOutput()。这就是图表死活不出来的最主要原因。

2. SQL查询语句有语法错误 #

你的SELECT子句里，字段之间没加逗号，数据库执行查询直接就报错了，导致拿不到数据，自然也画不出图。比如：

SELECT DISTINCT
[NHS_Number] = [A].[ID],
[Setting] = 'Acute',
[Event] = 'A&E Attendance'  -- 这里缺逗号！
[Type] = 'A&E Attendance'    -- 这里也缺逗号！
[Date] = [A].[Date]

每个字段定义后面都要加逗号（最后一个可以不加，但加上也没问题）。

3. ObserveEvent嵌套位置错误 #

你把observeEvent()放在了executeQuery()函数里面，这会导致每次调用函数都注册一个新的观察者，逻辑会变得非常混乱，应该把它移到server的顶层，和其他server代码同级。

4. 日期输入用textInput容易踩坑 #

用textInput()让用户手动输入日期，很容易出现格式不统一的问题（比如用户输成2019-04-01而不是01-APR-2019），建议换成dateInput()，既能让用户用日历选择，还能自动输出符合数据库要求的格式，避免手动输入出错。

修正后的完整代码 #

library(shiny)
library(shinythemes)
library(RODBC)
library(DBI)
library(ggplot2)
library(odbc)  # 记得加载这个包，不然dbConnect用odbc驱动会报错

# Define UI
ui <- fluidPage(theme = shinytheme("cerulean"),
                navbarPage(
                  "Business Intelligence R Application",
                  tabPanel("TheoGraph",
                           sidebarPanel(
                             tags$h3("Input:"),
                             textInput("nhsnumber", "Pseudonimised NHS Number", "1234"),
                             # 替换成dateInput，更友好且格式可控
                             dateInput("startdate", "Start Date:", value = as.Date("2019-04-01"), format = "dd-MMM-yyyy"),
                             dateInput("enddate", "End Date:", value = as.Date("2023-03-30"), format = "dd-MMM-yyyy"),
                             actionButton("submitBtn", "Submit"),
                             style = "background-color: #ADD8E6;"
                           ), # sidebarPanel
                           mainPanel(
                             h1("Header 1"),
                             h4("TheoGraph Output"),
                             verbatimTextOutput("txtout"),
                             plotOutput("plot")
                           ) # mainPanel
                  ) # Navbar 1, tabPanel
                ) # navbarPage
)

# Define server logic
server <- function(input, output, session) {  # 别忘了加session参数！你之前的onSessionEnded要用它

  # Reactive values for database connection and result
  con3 <- reactiveVal(NULL)
  result <- reactiveVal(NULL)

  # Function to handle SQL query and result
  executeQuery <- function() {
    # Disconnect if there was a previous connection
    if (!is.null(con3())) {
      dbDisconnect(con3())
      con3(NULL)
    }

    # Connect to the database
    tryCatch({  # 加个异常捕获，方便排查连接错误
      con3_val <- DBI::dbConnect(
        odbc::odbc(),
        Driver = "SQL Server",
        Server = "SERVER",
        Database = "DATABASE",
        Trusted_Connection = "True"
      )
      con3(con3_val)

      # 修正SQL语句的逗号问题
      query <- sqlInterpolate(
        con3(),
        "
        DECLARE @NHS_NUMBER VARCHAR(50), @START DATE, @END DATE;
        SET @NHS_NUMBER = ?;
        SET @START = ?;
        SET @END = ?;

        SELECT DISTINCT
        [NHS_Number] = [A].[ID],
        [Setting] = 'Acute',
        [Event] = 'A&E Attendance',
        [Type] = 'A&E Attendance',
        [Date] = [A].[Date]
        FROM [A]  -- 去掉多余的Table关键字
        WHERE [A].[ID] = @NHS_NUMBER
        AND CAST([A].[Date] AS DATE) BETWEEN CAST(@START AS DATE) AND CAST(@END AS DATE)
        ",
        input$nhsnumber,
        as.character(input$startdate),  # dateInput返回的是Date类型，转成字符串传给SQL
        as.character(input$enddate)
      )

      result_val <- dbGetQuery(con3(), query)
      result(result_val)
    }, error = function(e) {
      showNotification(paste("查询出错：", e$message), type = "error")
      result(NULL)
    })
  }

  # 把observeEvent移到顶层，绑定submit按钮（或者输入变化，这里用按钮更符合用户操作逻辑）
  observeEvent(input$submitBtn, {
    executeQuery()
  })

  # Close the database connection when the app exits
  observe({
    session$onSessionEnded(function() {
      if (!is.null(con3())) {
        dbDisconnect(con3())
      }
    })
  })

  # Render text output
  output$txtout <- renderPrint({
    req(result())
    print(result())
  })

  # 修正图表渲染：用renderPlot，并且写绘图逻辑
  output$plot <- renderPlot({
    req(result())  # 确保有数据再绘图

    # 用ggplot绘制示例图，你可以根据需求调整
    ggplot(result(), aes(x = Date)) +
      geom_histogram(binwidth = 7, fill = "#ADD8E6", color = "black") +
      labs(title = "A&E Attendance Over Time", x = "Date", y = "Count") +
      theme_minimal()
  })
}

# Run the application
shinyApp(ui, server)

额外小提示 #

• 加了tryCatch来捕获数据库连接和查询的错误，方便你排查问题（比如连接失败、SQL语法错）
• 把Table [A]改成了[A]，SQL里FROM后面直接跟表名，不需要加Table关键字
• 绑定了submitBtn的点击事件来执行查询，而不是输入变化就自动查，更符合用户的操作习惯（用户填完所有参数再提交）

备注：内容来源于stack exchange，提问作者JBlackford