Question

以下代码的工作方式如下：如果我们刷并选择了几个点，这些点将暂时变为洋红色。（如果单击绘图面板，它们将恢复为原始颜色），然后，如果单击“活动颜色”按钮，这些刷点将永久变为相应的选定颜色。（如果我们在绘图面板上单击，它们将不恢复为原始颜色）。

library(ggplot2)
library(shiny)
library(colourpicker)

ui <- fluidPage(
  verticalLayout(
  actionButton("active_color",
               "active color"),
  colourInput("color", "color", value = "red", showColour = "background"),
  plotOutput("plot", brush = "plot_brush", click = "plot_click"),
  verbatimTextOutput("info")
  )
)

server <- function(input, output) {
  g <- ggplot(mtcars, mapping = aes(x = wt, y = mpg)) + geom_point()
  values <- reactiveValues(active_color = 0)

  observeEvent(input$active_color, {
    values$active_color <- 1
  })

  observeEvent(input$plot_click, {
    values$active_color <- 0
  })

  output$plot <- renderPlot({
    # create ggplot
    build <- ggplot_build(g)

    len_layer <- length(build$data)

    x <- build$data[[len_layer]]$x
    y <- build$data[[len_layer]]$y

    # brush information
    brush_info <- input$plot_brush
    id_x <- which(x >= brush_info$xmin & x <= brush_info$xmax)
    id_y <- which(y >= brush_info$ymin & y <= brush_info$ymax)
    # brush index
    id <- intersect(id_x, id_y)

    color_vec <- build$data[[len_layer]]$colour

    if(length(id) > 0) {
      if(values$active_color != 0) {

         color_vec[id] <- input$color

         g <<- g + geom_point(colour = color_vec)

     }

     color_vec[id] <-"magenta"
     g <- g + geom_point(colour = color_vec)
    }

   g

 })

 output$info <- renderPrint({
   input$plot_brush
 })
}
shinyApp(ui, server)

代码工作正常。但是，如果我对服务器功能进行一些更改。

server <- function(input, output) {
 g <- ggplot(mtcars, mapping = aes(x = wt, y = mpg)) + geom_point()
 values <- reactiveValues(active_color = 0)

 observeEvent(input$active_color, {
   values$active_color <- 1
 })

 observeEvent(input$plot_click, {
   values$active_color <- 0
 })

 output$plot <- renderPlot({
  # the change I made here
   make_change(g, input, values)
 })

 output$info <- renderPrint({
   input$plot_brush
 })
}


make_change <- function(g, input, values) {

  build <- ggplot_build(g)

  len_layer <- length(build$data)

  x <- build$data[[len_layer]]$x
  y <- build$data[[len_layer]]$y

  # brush information
  brush_info <- input$plot_brush
  id_x <- which(x >= brush_info$xmin & x <= brush_info$xmax)
  id_y <- which(y >= brush_info$ymin & y <= brush_info$ymax)
  # brush index
  id <- intersect(id_x, id_y)

  color_vec <- build$data[[len_layer]]$colour

  if(length(id) > 0) {
    if(values$active_color != 0) {

      color_vec[id] <- input$color

      g <<- g + geom_point(colour = color_vec)

   }

   color_vec[id] <-"magenta"
   g <- g + geom_point(colour = color_vec)
 }

 g
}

它与旧的服务器功能非常相似，唯一的区别是我提取了renderPlot中的所有代码，并使其成为新的功能make_change。如果运行，我们会发现临时选择（从颜色变为洋红色）可以正常工作，但永久的颜色更改不再起作用。

似乎<<-在renderPlot()中可以很好地工作，但是，如果它在一个函数中并且该函数在renderPlot()中，则它不起作用。

能否使第二台服务器与第一台服务器一样工作？由于我想编写一个泛型函数，因此如果使用第一个泛型函数，则serer函数太长，难以读取和修改。

Answer 1

这里的问题诊断不正确。问题与<<-是在函数内部还是在渲染内部无关。这里的问题与g变量的作用域有关。

实际上，一个超级简单的“解决方案”是使用<<-而不是<-来简单地定义ggplot。另一个类似的“解决方案”是在全局环境中将初始ggplot定义拉出服务器之外。这两种方法都可以解决当前的问题，但是我建议阅读一些有关R中特别是Shiny中的作用域规则的文章，以及有关<<-的工作原理以及其危险性的一些文章。如果您对<<-运算符和作用域规则没有很深入的了解，通常会导致意外的结果。

我一直在用引号说“修复”，因为它可以从技术上解决问题，但是我认为代码设计可以重构。

如果“ <<-”在函数中并且该函数在renderPlot（）中，则不起作用

1 个答案: