简体   繁体   中英

“<<-” does not work if it is in a function and the function is in renderPlot()

The following code is doing like: If we brush and select several points, these points would be turned to color magenta temporarily; (if we click on the plot panel, they would be recovered to original color) then, if we click the "active color" button, these brushed points would be turned to corresponding selected color permanently. (if we click on the plot panel, they would not be recovered to original color).

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)

The code works fine. However, if I make a little change on server function.

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
}

It is very similar to the old server function, the only difference is I extract all the code in renderPlot and make it a new function make_change . If we run, we can find the temporary selection (color to magenta) works fine, but the permanent color change does not work any more.

It seems like <<- works well in renderPlot() , however, it doesn't work if it is in a function and the function is in renderPlot() .

Is it possible to make the second server work as well as the first one? Since I want to write a generic function, if I use the first one, the serer function is too long, too hard to read and modify.

The diagnosis of the problem here is incorrect. The problem is not related to whether or not <<- is inside a function or inside a render. The problem here is related to the scoping of the g variable.

In fact, a super simple "fix" would be to simply define the ggplot initially with <<- rather than with <- . Another similar "fix" would be to pull out the initial ggplot definition to be outside of the server, in the global environment. Both of these would fix the issue at hand, but I would suggest doing some reading on scoping rules in R in general and in Shiny in particular, and doing some reading on how <<- works and why it's dangerous. Using the <<- operator often leads to unexpected results if you don't have a very deep understanding of it and scoping rules.

I kept saying "fix" in quotes because it will technically fix the problem, but I think the code design could be refactored.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM