Shiny + ggplot2 - plotOutput - 缩放 - 浮动 geom_text 位置

Question

我有一个plotOutput。用户选择一个子区域，然后双击，然后绘图范围（通过调用ggplot 的coord_cartesian）进行调整，以便图形现在在子区域上缩放。它工作正常：从 img1 到 img2。

问题在于geom_text 标签的位置，因为它目前以绝对值 (x=Score - .75) 指定不适应比例的变化。结果是一个乱七八糟的图（img2）。

我尝试将x=Score - .15 替换为Score-((ranges$x[2]-ranges$x[1])*.2)；后一个表达式是一个 double，其值取决于当前的缩放级别。 但是当我进行替换时，R 不喜欢它（这是我得到的错误）：

Listening on http://127.0.0.1:7310
Warning: Error in : Aesthetics must be either length 1 or the same as the data (4): x, label, y
Stack trace (innermost first):
    110: check_aesthetics
    109: f
    108: l$compute_aesthetics
    107: f
    106: by_layer
    105: ggplot2::ggplot_build
    104: print.ggplot
    103: print
     92: <reactive:plotObj>
     81: plotObj
     80: origRenderFunc
     79: output$XassetOverview
      4: <Anonymous>
      3: do.call
      2: print.shiny.appobj
      1: print

Img1: 图2：

完整代码（有问题的行已注释掉）：

server = function (input, output){
  # store range in a reactiveValues pair
  ranges <- reactiveValues(x = NULL, y = NULL)
  # generate the data
  XassetOverviewData <- reactive({
    dataCrossAsset <- data.frame(c("point1", "point2", "point3"), c(50,33,45), c(49,50,53))
    dataCrossAsset <-
      setNames(dataCrossAsset,
               c("Name", "Correlation", "Score"))
    return(dataCrossAsset)
  })
  # generate the plot
  output$XassetOverview <- renderPlot({
    ggplot(XassetOverviewData(), aes(x = Score, y = Correlation)) + 
      geom_point(size = 5) + 
      coord_cartesian(xlim = ranges$x, ylim = ranges$y) +  
      geom_text(aes(x = Score - .15, label = Name), size = 3) 
      # solution... causing a bug: 
      # geom_text(aes(x = Score -  ((ranges$x[2]-ranges$x[1])*.2), label = Name), size = 2) 
  })
  # observeEvent
  observeEvent(input$plot1_dblclick, {
    brush <- input$plot1_brush
    if (!is.null(brush)) {
      ranges$x <- c(brush$xmin, brush$xmax)
      ranges$y <- c(brush$ymin, brush$ymax)

    } else {
      ranges$x <- NULL
      ranges$y <- NULL
    }
    adjustment <- ((ranges$x[2]-ranges$x[1])*.2)
    cat(adjustment, file = stderr())
   })
}

ui = basicPage(plotOutput(click = "plot_click",
                          outputId = "XassetOverview",
                          dblclick = "plot1_dblclick",
                          brush = brushOpts(id = "plot1_brush", resetOnNew = TRUE)
))

shinyApp(server=server, ui=ui)

Answer 1

原因是最初ranges$x 为空。所以你将一个空值传递给geom_text。您应该通过检查ranges$x:if(length(ranges$x)) 的长度来简单检查是否已经发生双击。

server = function (input, output){
  # store range in a reactiveValues pair
  ranges <- reactiveValues(x = NULL, y = NULL)
  # generate the data
  XassetOverviewData <- reactive({
    dataCrossAsset <- data.frame(c("point1", "point2", "point3"), c(50,33,45), c(49,50,53))
    dataCrossAsset <-
      setNames(dataCrossAsset,
               c("Name", "Correlation", "Score"))
    return(dataCrossAsset)
  })
  # generate the plot
  output$XassetOverview <- renderPlot({
      plot <- ggplot(XassetOverviewData(), aes(x = Score, y = Correlation)) + 
              geom_point(size = 5) + 
              coord_cartesian(xlim = ranges$x, ylim = ranges$y) +  
              geom_text(aes(x = Score - .15, label = Name), size = 3)
              if(length(ranges$x)){
                plot <- plot + geom_text(aes(x = Score -  ((ranges$x[2]-ranges$x[1]) *.1), label = Name), size = 3)
              } else{
                plot <- plot +  geom_text(aes(x = Score - .15, label = Name), size = 3) 
              }
      plot
  })
  # observeEvent
  observeEvent(input$plot1_dblclick, {
    brush <- input$plot1_brush
    if (!is.null(brush)) {
      ranges$x <- c(brush$xmin, brush$xmax)
      ranges$y <- c(brush$ymin, brush$ymax)
    } else {
      ranges$x <- NULL
      ranges$y <- NULL
    }
    adjustment <- ((ranges$x[2]-ranges$x[1])*.2)
    cat(adjustment, file = stderr())
  })
}

ui = basicPage(plotOutput(click = "plot_click",
                          outputId = "XassetOverview",
                          dblclick = "plot1_dblclick",
                          brush = brushOpts(id = "plot1_brush", resetOnNew = TRUE)
))

shinyApp(server=server, ui=ui)