Update rhandsontable from drgged makers on plotly or other values in server.

[waterwombat]

I am creating an shinyapp to allow users to change the shape of a curve by either editing xy values in a table, which are then plotted in plotly line chart, or alternatively, by dragging markers on the chart - in this case I would like the change in xy coordinates of the markers on the chart to be updated in the table. So the rhandsontable changes the chart and the chart changes the rhadsontable

The code for getting the xy markervalues and redrawing the spline come from plotly.R/app.R at master · plotly/plotly.R · GitHub

I have also posted this here:
updating values in rhandsontable from dragged points on plotly chart - or more generally from values on server · Issue #410 · jrowen/rhandsontable (github.com)

here is the example - only working from table to chart not chart to table:

library(shiny)
library(dplyr)
library(rhandsontable)
library(purrr)
library(plotly)
maxX = 100
n = maxX + 1
startDF <- data.frame(X = c(0, 20, 30, maxX), Y = c(1, 2, 3, 4))

ui <- fluidPage(
  column(
    3,
    h4("Editable handsontable"),
    rHandsontableOutput('table'),
    br(),
    h4("Values to update in handsontable from moving blue dots on figure"),
    textOutput("newPoint"),
    h4("so the values in table above become:"),
    tableOutput("outTab"),
    tableOutput('table1')
  ),
  column(
    6,
    h4("Click and drag blue markers to change the curve"),
    plotlyOutput("p")
  )
)

server <- function(input, output, session) {
  rv <- reactiveValues()
  rv$tab <- startDF
  
  #editable handsontable  with QC only updates with correct values
  df <- eventReactive(input$table ,  {
    if (is.null(input$table))  {
      df <- rv$tab
      dfOld <<- df
    } else {
      df <- hot_to_r(input$table)
      #  Quality control
      # Rule 1: maintain X values in correct order with extreme values as 0 and maxX
      ifelse(
        df$X[1] != 0 |
        df$X[1] >= df$X[2] |
        df$X[2] >= df$X[3] |
        df$X[3] >= df$X[4] |
        df$X[4] != maxX,
        df$X <- dfOld$X,
        df$X <- df$X
      )
    }
    dfOld <- df
    df
  },
  ignoreNULL = F)
  
  output$table <- renderRHandsontable({
    rhandsontable(df()) %>%
      #hot_col("Parameter", readOnly = TRUE)%>%
      hot_validate_numeric(
        col = 'X',
        min = 0,
        max = maxX,
        allowInvalid = FALSE
      ) %>%
      hot_validate_numeric(col = 'Y',
                           min = 0,
                           allowInvalid = FALSE)
  })
  
  
  observe(rv$tab <- df())
  
  observeEvent(rv$tab$X |
                 rv$tab$Y , {
                   rv$mySpline <- as.data.frame(spline(
                     rv$tab$X,
                     rv$tab$Y,
                     xmin = 0,
                     xmax = maxX,
                     n = n
                   )) %>%
                     mutate(y = ifelse(y < 0, 0, y))
                   
                   maxY <- 1.5 * (max(c(rv$mySpline$y)))
                   mySpline <- rv$mySpline
                   circles <- map2(
                     rv$tab$X,
                     rv$tab$Y,
                     ~ list(
                       type = "circle",
                       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 = "blue")
                     )
                   )
                   
                   # # # plot the shapes and fitted line
                   p = plot_ly() %>%
                     add_lines(
                       x = ~ rv$mySpline$x,
                       y = ~ rv$mySpline$y,
                       name = "Response curve",
                       line = list(color = "black")
                     ) %>%
                     layout(
                       shapes = c(circles),
                       xaxis = list(range = c(0, maxX), fixedrange = TRUE),
                       yaxis = list(range = c(0, maxY))
                     ) %>%
                     config(edits = list(shapePosition = TRUE))
                   
                   output$p <- renderPlotly(p)
                   
                 })
  
  observe({
    ed <- event_data("plotly_relayout")
    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$tab[row_index, 1:2] <- pts
    print(rv$tab)
    output$outTab <- renderTable(rv$tab)
    output$newPoint <-
      renderText(paste("Altered point: row =", row_index, "X =", pts[1], "Y=", pts[2]))
  })
}

shinyApp(ui, server)