求助：Shiny应用无报错但无法生成折线图问题排查

核心问题分析 #

你的代码运行无报错但无法渲染折线图，主要有以下几个关键原因：

• ggplot绘图代码位置错误：原代码将ggplot放在repeat循环内部且位于break条件之后。第二次循环触发break时，ggplot代码根本不会执行，导致renderPlot无绘图对象返回。
• 输入控件参数类型错误：numericInput的value、min等参数用了字符串（如'5'），虽R会隐式转换，但可能引发计算异常，不符合控件参数规范。
• 模拟逻辑可能导致数据无效：当Screen Sensitivity设为0时，test.result全为0，后续计算sensitivity会出现screen + interval = 0的情况，生成NaN值，导致ggplot无有效数据可绘制。
• repeat循环逻辑冗余：当前循环执行2次，但第二次结果直接覆盖第一次，未实现多次模拟汇总的效果，反而增加计算开销。

修复后的代码 #

library(shiny)
library(tidyverse)

ui <- fluidPage(
  numericInput(inputId = 'y',
               label = 'Mean Sojourn Time',
               value = 5,  # 改为数值型参数
               min = 1),
  numericInput(inputId = 'pr',
               label = 'Screen Sensitivity',
               value = 0.25,  # 初始值设为非0，避免无数据场景
               min = 0,
               max = 1,
               step = 0.25),
  plotOutput(outputId = 'lineplot')
)

server <- function(input, output) {
  output$lineplot <- renderPlot({
    t_0 <- 40 
    startage <- 50
    n <- 100000
    k <- 30
    x <- 0.58
    lambda <- -(log(1-x))/k 
    y <- as.numeric(input$y)  # 确保输入转为数值型
    mu <- 1/y
    num.screen <- 1:10
    pr <- as.numeric(input$pr)
    
    # 移除冗余循环，若需多次模拟可重新设计汇总逻辑
    t_p <- t_0 + rexp(n, lambda)
    t_c <- t_p + rexp(n, mu)
    
    newdf <- data.frame(t_p, t_c) %>% 
      filter(t_c <= 100)
    cancerdf <- mutate(newdf, id = row_number()) %>% 
      select(id, everything()) 
    
    result <- reframe(cancerdf, screen.num = num.screen, .by = id)
    ddset <- cancerdf %>% 
      right_join(result, by = "id") %>% 
      mutate(screen.age = screen.num + startage - 1) %>%
      filter(t_c > startage,
             t_c > screen.age) %>%
      filter(t_c > screen.age | t_c - screen.age <= 1) 
    ddset$test.result <- rbinom(nrow(ddset), 1, prob = pr)
    
    new.ddset <- ddset %>% 
      filter(cumsum(test.result) <= 1 & test.result == cummax(test.result), .by = id) %>%
      filter(t_p < screen.age, t_c > screen.age) %>% 
      group_by(id) %>%
      mutate(screen = ifelse(test.result == 1 & t_c > screen.age, 1, 0)) %>% 
      mutate(interval = ifelse(t_c - screen.age > 1, 0, 1 ),
             interval = ifelse(screen == 1 & interval == 1, 0, interval)) %>%
      ungroup()  # 取消分组避免后续汇总异常
    
    simulation.sensitivity <- new.ddset %>% 
      group_by(screen.age) %>% 
      summarise(screen = sum(screen, na.rm = TRUE),
                interval = sum(interval, na.rm = TRUE),
                # 处理除以0的情况，避免生成NaN
                sensitivity = ifelse(screen + interval == 0, 0, screen / (screen + interval))) %>%
      ungroup()
    
    # 将ggplot移到循环外，确保返回绘图对象
    simulation.sensitivity %>% 
      ggplot(aes(x = screen.age, y = sensitivity)) +
      geom_point() +
      geom_smooth(method = 'lm', se = FALSE) +
      theme_minimal() +
      labs(x = "筛查年龄", y = "灵敏度")  # 添加轴标签增强可读性
  })
}

shinyApp(ui = ui, server = server)

额外优化建议 #

1. 多次模拟汇总：若需减少随机性，可将模拟逻辑封装为函数，用map_dfr循环多次并计算均值。
2. 数据有效性检查：在绘图前添加req()或validate()，确保simulation.sensitivity有有效数据时才绘制图表。
3. 性能优化：n=100000计算缓慢，可适当减小样本量，或用reactive()缓存中间结果。

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