Update scatter in plotly by dragging shapes (shiny)

I am trying to make the scatter plot update when I drag some shapes in plotly. The shapes are "handles" for the whole graph. The scatter plot doesn't update even though I've dragged the shapes and the Y values should have changed. I think this code https://stackoverflow.com/questions/47280032/draggable-line-chart-in-r-shiny (the one at the bottom) is something I could use but I'm too inexperienced to understand it.
Here's my code

library(shiny)
library(dplyr)
library(plotly)
library(purrr)
library(tidyverse)
ui <- fluidPage("Draggable Graph",
                plotlyOutput("Draggable_Graph")
                
)

server <- function(input, output, session) {
  Xs <- seq(2010,2050,1)
  Ys <- c(5,50) 
  
  #Circles as "handles" for the graph
  X_Boundaries <- enframe(list(min(Xs), max(Xs))) %>%
    mutate("Y_val" = c(min(Ys), max(Ys)))
  circles <- pmap(
    X_Boundaries,
    function(name, value, Y_val) {
      list(
        type = "circle",
        xanchor = value,
        yanchor = Y_val,
        x0 = -5,
        y0 = -5,
        x1 = 5,
        y1 = 5,
        xsizemode = "pixel",
        ysizemode = "pixel",
        # other visual properties
        fillcolor = "red",
        line = list(color = "transparent"),
        layer = "below"
      )
    }
  )
  
  #All the points in between
  FillinYs <- reactive(seq(from = circles[[1]]$yanchor, to = circles[[2]]$yanchor, by = 
                                (circles[[2]]$yanchor - circles[[1]]$yanchor)/(max(Xs) - min(Xs))
  ))
  #Create plot
  output$Draggable_Graph <- renderPlotly(
    plot_ly(X_Boundaries) %>%
      add_markers(x = Xs, y = FillinYs(), opacity = 0.3) %>%
      layout(shapes = circles) %>%
      config(edits = list(shapePosition = TRUE)))
  
  
}

shinyApp(ui, server)

Hi @Rankineplant. This feature is tricky. You have to define the circle objects and overlay on the plot and enable the edition and report the position. So, you can get the coordination of the edited circle by event_data. The report coordination is a named list. Observe the change of coordination and update the grey dots. And also update the coordination of the overlay circle objects. I also fixed the axes ranges, so you can see the plot difference after moving the circles.

library(shiny)
library(dplyr)
library(plotly)
library(purrr)
library(tidyverse)
ui <- fluidPage("Draggable Graph",
                plotlyOutput("Draggable_Graph")
                
)

server <- function(input, output, session) {
  
  circle1 <- reactiveValues(x = 2010, y = 5)
  circle2 <- reactiveValues(x = 2050, y = 50)
  
  #All the points in between
  observe(
    {
      ed <- event_data("plotly_relayout")
      req(ed)
      isolate(
        {
          if (grepl("shapes\\[0\\]", names(ed)[1])) {
            circle1$x <- ed[[1]]
            circle1$y <- ed[[2]]
          }
          if (grepl("shapes\\[1\\]", names(ed)[1])) {
            circle2$x <- ed[[1]]
            circle2$y <- ed[[2]]
          }
        }
      )
    }
  )
  
  #Create plot
  output$Draggable_Graph <- renderPlotly(
    {
      circles <- map(
        list(circle1, circle2),
        ~{
          list(
            type = "circle",
            xanchor = floor(.x$x),
            yanchor = .x$y,
            x0 = -5,
            y0 = -5,
            x1 = 5,
            y1 = 5,
            xsizemode = "pixel",
            ysizemode = "pixel",
            # other visual properties
            fillcolor = "red",
            line = list(color = "transparent"),
            layer = "below"
          )
        }
      )
      
      X <- seq.int(floor(circle1$x), floor(circle2$x))
      
      FillinYs <- seq(from = circle1$y, to = circle2$y, length.out = length(X))
      
      plot_ly() %>%
        add_markers(x = X, y = FillinYs, opacity = 0.3) %>%
        layout(shapes = circles, xaxis = list(range = c(2005, 2055)), yaxis = list(range = c(0, 55))) %>%
        config(edits = list(shapePosition = TRUE))
    })
}

shinyApp(ui, server)
2 Likes

That's nothing short of incredible, thank you so much!! I'll try to give you credit if a good opportunity arises.
If you could explain why all the changes were necessary in more detail that would be awesome because I don't really understand them, but if not, at least you solved my problem.
I will be developing this more and want to understand the mechanics so that I can avoid the same getting stuck in future.

@Rankineplant. In my code, I define two reactive values circle1 and circle2 to store the coordinate of the two shapes with initiate coordinate.
Because setting the shapePosition = TRUE, the coordinate of the shapes will be returned with event_data("plotly_relayout"). The return values will be a named list. The names will be shapes[0].xanchor and shapes[0].yanchor for the first shape and [1] for the second shape. So, we can update the x, y coordinate of the circle1 and circle2. And use circle1 and circle2 to update the circles and layout again on the plot. X and FillinYs is also updated with circle1 and circle2 for the coordinates of the grey dots.
Hope I can make myself clear.

1 Like

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.