You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

Shiny应用单点击绘制点不显示问题排查求助

avatar
API 探路者
2026-7-22
Shiny应用单点击放置的绿色点无法显示问题修复

开发的Shiny应用支持上传PNG图片后，通过双点击放置两个点并绘制连线，随后可在连线上单点击放置绿色点。目前双点击绘点及连线功能正常，但单点击时，坐标已正确存储到响应式数据框appState$points中，却无法绘制出对应点。

复现步骤：

  • 上传任意PNG图片
  • 双点击放置第一个点（蓝色）
  • 在绘图区其他位置双点击放置第二个点（红色），观察两点间的连线
  • 在连线上单点击，可看到数据框pointTable更新，但绿色点不显示

怀疑出错的代码段：

points_df <- reactive({ data.frame(x = appState$points$x, y = appState$points$y) }) 
if (nrow(points_df()) > 0) { 
  basePlot <- basePlot + geom_point(data = points_df(), aes(x, y), color = "green", size = 3) 
}

完整可复现代码：

library(shiny)
library(shinyjs)
library(magrittr)
library(ggplot2)
library(png)

ui <- fluidPage(
  useShinyjs(),
  titlePanel("Otolith Analysis"),
  sidebarLayout(
    sidebarPanel(fileInput(
      "otolithImage",
      "Upload Otolith Image",
      accept = c("image/png", "image/jpeg")
    )),
    mainPanel(
      plotOutput(
        "otolithPlot",
        click = "plot_click",
        dblclick = "plot_dblclick",
        hover = "plot_hover"
      ),
      tableOutput("pointTable")
    )
  )
)

server <- function(input, output, session) {
  # Variables to store the state of the app
  appState <- reactiveValues(
      center = NULL,
      endPoint = NULL,
      points = data.frame(x = numeric(), y = numeric())
  )
  
  otolithImage <- reactiveVal(NULL)
  
  observeEvent(input$otolithImage, {
    otolithImage(readPNG(input$otolithImage$datapath))
  })
  
  plotCoordinates <- function() {
    inFile <- input$otolithImage
    if (is.null(inFile)) {
      return(NULL)
    }
    
    img <- otolithImage()
    basePlot <- ggplot() + annotation_custom(grid::rasterGrob(
      img,
      width = unit(1, "npc"),
      height = unit(1, "npc")
    ),
    -Inf,
    Inf,
    -Inf,
    Inf) +
      theme_void() +
      coord_cartesian(xlim = c(0, dim(img)[2]), ylim = c(0, dim(img)[1]))
    
    if (!is.null(appState$center)) {
      basePlot <- basePlot + geom_point(
          aes(x = appState$center[1], y = appState$center[2]),
          color = "blue",
          size = 3
        )
    }
    
    if (!is.null(appState$endPoint)) {
      basePlot <- basePlot + geom_point(
          aes(x = appState$endPoint[1], y = appState$endPoint[2]),
          color = "red",
          size = 3
        ) +
        geom_segment(
          aes(
            x = appState$center[1],
            y = appState$center[2],
            xend = appState$endPoint[1],
            yend = appState$endPoint[2]
          ),
          color = "black"
        )
    }
    
    points_df <- reactive({
        data.frame(x = appState$points$x, y = appState$points$y)
      })
    if (nrow(points_df()) > 0) {
      basePlot <- basePlot + geom_point(data = points_df(),
                            aes(x, y),
                            color = "green",
                            size = 3)
    }
    
    return(basePlot)
  }
  
  output$otolithPlot <- renderPlot({
    plotCoordinates()
  }, bg = "transparent")
  
  observeEvent(input$plot_dblclick, {
    if (is.null(appState$center)) {
      appState$center <- c(input$plot_dblclick$x, input$plot_dblclick$y)
    } else if (is.null(appState$endPoint)) {
      appState$endPoint <- c(input$plot_dblclick$x, input$plot_dblclick$y)
    }
    output$otolithPlot <- renderPlot({
      plotCoordinates()
    }, bg = "transparent")
  })
  
  observeEvent(input$plot_click, {
    if (!is.null(appState$center) && !is.null(appState$endPoint)) {
      clickPoint <- c(input$plot_click$x, input$plot_click$y)
      lineVector <- appState$endPoint - appState$center
      pointVector <- clickPoint - appState$center
      projectionFactor <- sum(lineVector * pointVector) / sum(lineVector * lineVector)
      
      if (projectionFactor >= 0 && projectionFactor <= 1) {
        newPoint <- appState$center + projectionFactor * lineVector
        appState$points <- rbind(appState$points, newPoint)
      }
    }
    output$otolithPlot <- renderPlot({
      plotCoordinates()
    }, bg = "transparent")
  })
  
  # Render the table with point coordinates
  output$pointTable <- renderTable({
    appState$points
  })
  
  # Hover line
}

shinyApp(ui = ui, server = server)

问题根源

在plotCoordinates函数内部定义points_df <- reactive({})是错误的用法。Shiny的reactive()函数只能在server函数的顶层或者其他响应式上下文（比如observe()、render*()）中创建，不能在普通的自定义函数（如plotCoordinates）里定义响应式对象。这会导致points_df()无法正确响应appState$points的更新，甚至无法正确获取数据，因此绿色点无法被绘制。

修复方案

直接从appState$points创建数据框即可，不需要将其包装为reactive()。因为appState是reactiveValues对象，当它的points属性更新时，renderPlot会自动重新运行plotCoordinates函数，此时新的points数据会被正确读取并绘制。

修改后的plotCoordinates函数中对应代码段替换为：

points_df <- data.frame(x = appState$points$x, y = appState$points$y)
if (nrow(points_df) > 0) {
  basePlot <- basePlot + geom_point(data = points_df, aes(x, y), color = "green", size = 3)
}

完整修复后的代码 

library(shiny)
library(shinyjs)
library(magrittr)
library(ggplot2)
library(png)

ui <- fluidPage(
  useShinyjs(),
  titlePanel("Otolith Analysis"),
  sidebarLayout(
    sidebarPanel(fileInput(
      "otolithImage",
      "Upload Otolith Image",
      accept = c("image/png", "image/jpeg")
    )),
    mainPanel(
      plotOutput(
        "otolithPlot",
        click = "plot_click",
        dblclick = "plot_dblclick",
        hover = "plot_hover"
      ),
      tableOutput("pointTable")
    )
  )
)

server <- function(input, output, session) {
  # Variables to store the state of the app
  appState <- reactiveValues(
      center = NULL,
      endPoint = NULL,
      points = data.frame(x = numeric(), y = numeric())
  )
  
  otolithImage <- reactiveVal(NULL)
  
  observeEvent(input$otolithImage, {
    otolithImage(readPNG(input$otolithImage$datapath))
  })
  
  plotCoordinates <- function() {
    inFile <- input$otolithImage
    if (is.null(inFile)) {
      return(NULL)
    }
    
    img <- otolithImage()
    basePlot <- ggplot() + annotation_custom(grid::rasterGrob(
      img,
      width = unit(1, "npc"),
      height = unit(1, "npc")
    ),
    -Inf,
    Inf,
    -Inf,
    Inf) +
      theme_void() +
      coord_cartesian(xlim = c(0, dim(img)[2]), ylim = c(0, dim(img)[1]))
    
    if (!is.null(appState$center)) {
      basePlot <- basePlot + geom_point(
          aes(x = appState$center[1], y = appState$center[2]),
          color = "blue",
          size = 3
        )
    }
    
    if (!is.null(appState$endPoint)) {
      basePlot <- basePlot + geom_point(
          aes(x = appState$endPoint[1], y = appState$endPoint[2]),
          color = "red",
          size = 3
        ) +
        geom_segment(
          aes(
            x = appState$center[1],
            y = appState$center[2],
            xend = appState$endPoint[1],
            yend = appState$endPoint[2]
          ),
          color = "black"
        )
    }
    
    # 修复：直接创建数据框，无需reactive包装
    points_df <- data.frame(x = appState$points$x, y = appState$points$y)
    if (nrow(points_df) > 0) {
      basePlot <- basePlot + geom_point(data = points_df,
                            aes(x, y),
                            color = "green",
                            size = 3)
    }
    
    return(basePlot)
  }
  
  output$otolithPlot <- renderPlot({
    plotCoordinates()
  }, bg = "transparent")
  
  observeEvent(input$plot_dblclick, {
    if (is.null(appState$center)) {
      appState$center <- c(input$plot_dblclick$x, input$plot_dblclick$y)
    } else if (is.null(appState$endPoint)) {
      appState$endPoint <- c(input$plot_dblclick$x, input$plot_dblclick$y)
    }
    output$otolithPlot <- renderPlot({
      plotCoordinates()
    }, bg = "transparent")
  })
  
  observeEvent(input$plot_click, {
    if (!is.null(appState$center) && !is.null(appState$endPoint)) {
      clickPoint <- c(input$plot_click$x, input$plot_click$y)
      lineVector <- appState$endPoint - appState$center
      pointVector <- clickPoint - appState$center
      projectionFactor <- sum(lineVector * pointVector) / sum(lineVector * lineVector)
      
      if (projectionFactor >= 0 && projectionFactor <= 1) {
        newPoint <- appState$center + projectionFactor * lineVector
        appState$points <- rbind(appState$points, newPoint)
      }
    }
    output$otolithPlot <- renderPlot({
      plotCoordinates()
    }, bg = "transparent")
  })
  
  # Render the table with point coordinates
  output$pointTable <- renderTable({
    appState$points
  })
  
  # Hover line
}

shinyApp(ui = ui, server = server)

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

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级，最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分)， 限时 9.9 元起

产品介绍相关文档
相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级，最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分)， 限时 9.9 元起

产品介绍相关文档
火山引擎 最新活动
全面开放
Doubao-Seedance-2.5全新模型升级

模型再升级,30秒超长叙事, 模态参考扩容

HOT
方舟Codingplan

模型自由，工具不限，最新支持 Deepseek-V4 系列、GLM-5.3 系列

HOT
方舟Agent plan

超全模态模型 × Harness 升级，最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列

HOT
新用户特惠专场

大模型19元起，Al应用9.9元畅享，新人首购爆款尽享优惠

最近更新时间：2026.07.22 07:12:05