Problem with a chart where points can be dragged from one position to another in the case when data array to plot is based on label retrieved from Shiny Radio button reactively

[andrepoorman]

I assign a name to a Reactive Value via a Radio Button. I then select in the dataframe the column with that name. I plot the column. I then try to drag the points to new positions.
(see example at link).
This causes an error message.
Warning: The 'plotly_relayout' event tied a source ID of 'fig_expoD' is not registered. In order to obtain this event data, please add event_register(p, 'plotly_relayout') to the plot (p) that you wish to obtain event data from.
Warning: Error in <-: object of type 'closure' is not subsettable
This works if the data column is set through a standard rather than a reactive statement.

I tried with no success in my "observe" clause to change "rv_expoD$x[row_index]" to
"rv_expoD()$x[row_index]" or "rv_expoD$x()[row_index]" or rv_expoD$xrow_index

The code listed below will run fine if you set the statement "test_problem <- FALSE".
If you change it to "test_problem <- TRUE" and you try to drag the points, you will get the errors.

Somehow I cannot find the solution to this. Help, please! Regards, Andre

This link explains the draggable points on chart feature:

[javascript - Draggable line chart in R/Shiny - Stack Overflow]

# v 5.0 mb 052521 052121 - 050421 - 042921
# Test5_VsA.R

#
# R Code to illustrate problem with a chart where points can be dragged from one position
# to other in the case when data array to plot is based on label retrieved from Shiny Radio button
#

library(shiny)
library(plotly)
library(purrr)

z_curves_expos_delta <-
  data.frame(
    Tenor = c("SPOT", "BALM", "PRPT", "1_YR"),
    Month = c(0, 0.5, 1, 12),
    NG_NYMEX = c(10000, 5000, 1000, 3000),
    LG_JKM = c(1000, 7000, 1000, 4000),
    CR_WTI = c(8000, 4000, 2500, 1000)
  )

ui <- fluidPage(titlePanel("Code to illustrate problem"),
                
                sidebarLayout(sidebarPanel(
                  radioButtons(
                    "curve",
                    "Curve name:",
                    c(
                      "NG_NYMEX" = "NG_NYMEX",
                      "LG_JKM" = "LG_JKM",
                      "CR_WTI" = "CR_WTI"
                    ),
                    selected = "NG_NYMEX"
                  ),
                ),
                mainPanel(
                  tabsetPanel(
                    type = "tabs",
                    
                    tabPanel("TABLE",
                             fluidRow(column(
                               1, tableOutput("table_expoD")
                             ), )),
                    tabPanel("CHART",
                             fluidRow(column(
                               1, plotlyOutput("p_expoD")
                             ), ))
                  )
                )))

server <- function(input, output, session) {
  # SELECT DATA
  
  z_months <- reactive({
    z_curves_expos_delta$Month
  })
  
  z_curve <- reactive({
    input$curve
  })
  
  z_exposD <- reactive({
    z_curves_expos_delta[, z_curve()]
    
  })
  
  rv_expoD <- reactiveValues(x = z_months,
                             y = z_exposD)
  
  # POPULATE TABLE
  
  data_expoD <- reactive({
    d <-
      data.frame(
        Deltas = rv_expoD$x()
        ,
        Original = z_exposD()
        ,
        Scenario = rv_expoD$y()
      )
    d
  })
  
  output$table_expoD <- renderTable({
    data_expoD()
  })
  
  # PLOT CHART
  
  grid_expoD <- reactive({
    data.frame(x = seq(min(rv_expoD$x()), max(rv_expoD$x()), length = 10))
    
  })
  
  output$p_expoD <- renderPlotly({
    # creates a list of circle shapes from x/y data
    circles <- map2(
      rv_expoD$x(),
      rv_expoD$y(),
      ~ list(
        type = "circle",
        # anchor circles at (mpg, wt)
        xanchor = .x,
        yanchor = .y,
        # give each circle a 2 pixel diameter
        x0 = -4,
        x1 = 4,
        y0 = -4,
        y1 = 4,
        xsizemode = "pixel",
        ysizemode = "pixel",
        # other visual properties
        fillcolor = "blue",
        line = list(color = "transparent")
      )
    )
    
    fig <- plot_ly(source = "fig_expoD") %>%
      add_markers(
        x = z_months(),
        y = z_exposD(),
        color = I("green"),
        name = "exposures Delta",
        type = 'scatter'
      )
    
    fig <-
      fig %>% add_bars(
        x = rv_expoD$x(),
        y = rv_expoD$y(),
        color = I("red"),
        name = "scenario"
      )
    
    fig <-
      fig %>% add_bars(
        x = z_months(),
        y = z_exposD(),
        color = I("green"),
        name = "originals"
      )
    
    fig <-
      fig %>% layout(shapes = circles) %>% config(edits = list(shapePosition = TRUE))
    
    fig
    
  })
  
  ########## FLAG TO TEST PROBLEM #########
  
  test_problem = TRUE
  
  #########################################
  
  if (test_problem)
  {
    observe({
      ed <- event_data("plotly_relayout", source = "fig_expoD")
      shape_anchors <-
        ed[grepl("^shapes.*anchor$", names(ed))]
      if (length(shape_anchors) != 2)
        return()
      row_index <-
        unique(readr::parse_number(names(shape_anchors)) + 1)
      pts <- as.numeric(shape_anchors)
      rv_expoD$x[row_index] <- pts[1]
      rv_expoD$y[row_index] <- pts[2]
      
    })
    
  }
  
}

shinyApp(ui, server)