«<< -» не работает, если оно находится в функции, а функция находится в renderPlot ()

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 в частности, а также прочитать о том, как работает <<- и почему это опасно.Использование оператора <<- часто приводит к неожиданным результатам, если вы не очень хорошо понимаете его и определяете правила.

Я продолжал говорить «исправить» в кавычках, потому что это технически решит проблему, ноЯ думаю, что дизайн кода может быть изменен.