Moveable Vertical Lines Not Saving Position Every time They Move

shiny
, , ,
1

So, I've been working on a project that involves having moveable lines on my plot in Shiny. I've followed the answers given here and it worked really great! Then, I needed to make some modifications which happened here. So far, so good. However, my issue now is that I am trying to add a second moveable line onto this plot, and it's really not working out. Every time I move the second line, the first one reverts back to its original position. I have a feeling this is because !is.null(d[["shape[0].x0"]]) is evaluating to be FALSE, making the line go back to the minimum x value. Perhaps I've done something wrong here, especially since I'm quite new with Shiny. You can see a GIF attached which demonstrates the issue:

trimmed

Here is my code, with the data modified so that it can be reproduced.

I think my issue is in the selected_point variable. I am trying to create two points, (x,y) and (x2,y2) so that I can "save" both intersections of the vertical lines with the curve in red. However, I feel like I am doing something wrong here. The problem could also be in the plot_ly function and how I am implementing the vertical lines, but I'm really not sure. Any help, hints, or tips would be much appreciated!

server <- function(input, output, session) {

    rv <- reactiveValues(x = NULL, y = NULL, x2 = NULL, y2 = NULL)

    s <- reactive({
        rv$x <- c(-100:100)
        rv$y <- c(-100:100)**2
        
        rv$x2 <- c(-100:100)
        rv$y2 <- c(-100:100)**2
        
        d <- event_data("plotly_relayout", source = "trajectory")

        selected_point <- if (!is.null(d[["shapes[0].x0"]])) {
            xint <- d[["shapes[0].x0"]]
            xpt <- rv$x[which.min(abs(rv$x - xint))]
            rv$save_x <- xpt
            if (!is.null(d[["shapes[1].x0"]])) {
                xint2 <- d[["shapes[1].x0"]]
                xpt2 <- rv$x[which.min(abs(rv$x - xint2))]
                rv$save_x2 <- xpt2 
                list(x = xpt, y = rv$y[which.min(abs(rv$x - xint))],
                     x2 = xpt2, y2 = rv$y[which.min(abs(rv$x - xint2))])
            }
            else {
                list(x = xpt, y = rv$y[which.min(abs(rv$x - xint))],
                            x2 = min(rv$x), y2 = rv$y[which(rv$x == min(rv$x))])
            }
        } else {
            if (!is.null(d[["shapes[1].x0"]])) {
                xint2 <- d[["shapes[1].x0"]]
                xpt2 <- rv$x[which.min(abs(rv$x - xint2))]
                rv$save_x2 <- xpt2 
                list(x = min(rv$x), y = rv$y[which(rv$x == min(rv$x))],
                            x2 = xpt2, y2 = rv$y[which.min(abs(rv$x - xint2))])
            }
            else{
                list(x = min(rv$x), y = rv$y[which(rv$x == min(rv$x))],
                            x2 = min(rv$x), y2 = rv$y[which(rv$x == min(rv$x))])
            }
        }
        plot_ly(color = I("red"), source = "trajectory") %>%
            add_lines(x = rv$x, y = rv$y) %>%
            add_markers(x = selected_point$x, y = selected_point$y) %>%
            add_markers(x = selected_point$x2, y = selected_point$y2) %>%
            layout(shapes = list( 
                list(
                    type = "line",
                    line = list(color = "gray", dash = "dot"),
                    x0 = selected_point$x,
                    x1 = selected_point$x,
                    y0 = 0,
                    y1 = 1,
                    yref = "paper"),
                list(
                    type = "line",
                    line = list(color = "black", dash = "solid"),
                    x0 = selected_point$x2,
                    x1 = selected_point$x2,
                    y0 = 0,
                    y1 = 1,
                    yref = "paper")
            )) %>%
            config(editable = TRUE)
       })
      output$new_plot <- renderPlotly({
           s()
       })
})

ui <- fluidPage(
plotlyOutput("new_plot")
)
2 
library(shiny)
library(plotly)

server <- function(input, output, session) {
  
  rv <- reactiveValues(x = NULL, y = NULL,sa_x=-100,sb_x=-100)
  
  s <- reactive({
    rv$x <- c(-100:100)
    rv$y <- c(-100:100)**2

    d <- event_data("plotly_relayout", source = "trajectory")
    selected_point_a <- {if (!is.null(d[["shapes[0].x0"]])) {
      xint <- d[["shapes[0].x0"]]
      xpt <- rv$x[which.min(abs(rv$x - xint))]
      rv$sa_x <- xpt
      
    }  
      list(x = rv$sa_x, y = rv$y[which.min(abs(rv$x - rv$sa_x))])}
    
    selected_point_b <- {if (!is.null(d[["shapes[1].x0"]])) {
      xint <- d[["shapes[1].x0"]]
      xpt <- rv$x[which.min(abs(rv$x - xint))]
      rv$sb_x <- xpt
      
    }  
      list(x = rv$sb_x, y = rv$y[which.min(abs(rv$x - rv$sb_x))])}
    
    
    plot_ly(color = I("red"), source = "trajectory") %>%
      add_lines(x = rv$x, y = rv$y) %>%
      add_markers(x = selected_point_a$x, y = selected_point_a$y) %>%
      add_markers(x = selected_point_b$x, y = selected_point_b$y) %>%
      layout(shapes = list( 
        list(
          type = "line",
          line = list(color = "gray", dash = "dot"),
          x0 = selected_point_a$x,
          x1 = selected_point_a$x,
          y0 = 0,
          y1 = 1,
          yref = "paper"),
        list(
          type = "line",
          line = list(color = "black", dash = "solid"),
          x0 = selected_point_b$x,
          x1 = selected_point_b$x,
          y0 = 0,
          y1 = 1,
          yref = "paper")
      )) %>%
      config(editable = TRUE)
  })
  output$new_plot <- renderPlotly({
    s()
  })
}

ui <- fluidPage(
  plotlyOutput("new_plot")
)

shinyApp(ui, server)
1 Like
3

Thank you! That was really helpful. I guess my only concern now is the initialization of sa_x and sb_x inside the reactive values. The way I've set it up for my code, I do not know the initialized values yet until I enter the reactive statement. As such, I cannot say sa_x = -100 and sb_x = -100 outside of the reactiveValues. When I try to move it into the reactive statement as follows

    rv <- reactiveValues(x = NULL, y = NULL,
                         sa_x = NULL, sb_x = NULL)

s <- reactive({
# Data frame is defined WITHIN the reactive statement. 
        dat <- data.frame()
# Extract the correct x and y values.
        rv$x <- as.vector(dat$time)
        rv$y <- as.vector(dat$location)
#Initialize the starting points. 
        rv$sa_x <- min(rv$x)
        rv$sb_x <- min(rv$x)

This is producing the same error that I had before. It seems like I cannot initialize the starting points inside the reactive statement, because the lines go back to the beginning each time the other one is moved. Perhaps there is a way around this, but the creation of the data frame needs to happen inside the reactive statement, so I am not able to initialize sa_x and sb_x beforehand.

4 
 rv <- reactiveValues(x = NULL, y = NULL,
                       sa_x = NULL, sb_x = NULL)
  
  s <- reactive({
    # Data frame is defined WITHIN the reactive statement. 
 
    # Extract the correct x and y values.
    n <- 100
    set.seed(42)
    rv$x <- 1:n
    rv$y <- as.vector(cumsum(sample(c(-1, 1), n, TRUE)))
    #Initialize the starting points. 
    rv$sa_x <- if(isTruthy(rv$sa_x))
                  rv$sa_x
                else 
                  min(rv$x)
    rv$sb_x <- if(isTruthy(rv$sb_x))
      rv$sb_x
    else 
      min(rv$x)
1 Like
5

Thanks once again. This was really helpful, and it solved my issue!

6

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