How can use R shiny to plot interactive charts on one page which should reflect different reactive values for each chart

When I use R shiny to plot interactive charts on one page which should reflect different reactive values for each chart, all the charts change when I move the points in any of the individual charts. I would like only the chart where I move the points to be redrawn. I thought I could achieve this by replicating the same code for each chart but simply changing the names of the reactive variables within the output object for each chart (which itself is given a name specific to each chart).

This is my code:

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


z_curves_expos <- data.frame(Tenor=c("SPOT", "BALM","PRPT","1_YR"),Month=c(0,0.5,1,12),NG_NYMEX=c(2,4,5,7),CR_WTI=c(30,40,35,40))
z_curves_prices <- data.frame(Tenor=c("SPOT", "BALM","PRPT","1_YR"),Month=c(0,0.5,1,12),NG_NYMEX=c(10000,5000,1000,3000),CR_WTI=c(8000,4000,2500,1000))
z_curves_volas <- data.frame(Tenor=c("SPOT", "BALM","PRPT","1_YR"),Month=c(0,0.5,1,12),NG_NYMEX=c(15,20,25,25),CR_WTI=c(10,11,15,20))

z_tenors <- z_curves_expos$Tenor
z_months <- z_curves_expos$Month

z_expos <- z_curves_expos$NG_NYMEX
z_prices <- z_curves_prices$NG_NYMEX
z_volas <- z_curves_volas$NG_NYMEX

z_curve <- "NG_NYMEX"

ui <- fluidPage(
  titlePanel("QP VaR Scenario Analysis - CRMS in Shell T&S"),
fluidRow(
# column(5, verbatimTextOutput("summary")),
  column(6, plotlyOutput("p_expo")),
  column(6, plotlyOutput("p_pric")),
 column(6, plotlyOutput("p_vola")) 
# column(6, offset = 6, plotlyOutput("p_vola")) 
)
)

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

  ####################### EXPOSURES - START #######################  
  rv_expo <- reactiveValues(
    x = z_months,
    y = z_expos
  )
  grid_expo <- reactive({
    data.frame(x = seq(min(rv_expo$x), max(rv_expo$x), length = 10))

  })
  
#  model <- reactive({
#    d <- data.frame(x = rv_expo$x, y = rv_expo$y)
#    loess(y ~ x, d)
#  })
  
  
  output$p_expo <- renderPlotly({
    # creates a list of circle shapes from x/y data
    circles <- map2(rv_expo$x, rv_expo$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() %>%
    add_markers(x = z_months, y = z_expos, color = I("green"), name = "exposures")
    
#    fig <- fig %>%  add_lines(x = grid()$x, y = predict(loess(y ~ x, data.frame(x = z_months, y = z_expos) ), grid()), color = I("green"), name = "original")
#    fig <- fig %>% add_trace(x = grid()$x, y = predict(model(), grid()), color = I("red"), mode = "markers+lines", name = "scenario")
    
    fig <- fig %>% add_bars(x = z_months, y = z_expos, color = I("green"), name = "originals")
    
    fig <- fig %>% add_bars(x = rv_expo$x, y = rv_expo$y, color = I("red"), mode = "markers+bars", name = "scenario")
    
    fig <- fig %>% layout(shapes = circles) %>% config(edits = list(shapePosition = TRUE))
    fig
    
    
  })
  
  output$summary_expo <- renderPrint({a
    #    summary(model())
    z_curve
  })
  
  # update x/y reactive values in response to changes in shape anchors
  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_expo$x[row_index] <- pts[1]
    rv_expo$y[row_index] <- pts[2]
  })
  
  ####################### EXPOSURES - END #######################  
  
  
  
  
  ####################### PRICES - START #######################  
  rv_pric <- reactiveValues(
    x = z_months,
    y = z_prices
  )
  grid_pric <- reactive({
    data.frame(x = seq(min(rv_pric$x), max(rv_pric$x), length = 10))
  })
  
    model <- reactive({
    d <- data.frame(x = rv_pric$x, y = rv_pric$y)
    loess(y ~ x, d)
  })
    

  output$p_pric <- renderPlotly({
    # creates a list of circle shapes from x/y data
    circles <- map2(rv_pric$x, rv_pric$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() %>%
      add_markers(x = z_months, y = z_prices, color = I("green"), name = "prices") 
    fig <- fig %>%  add_lines(x = grid_pric()$x, y = predict(loess(y ~ x, data.frame(x = z_months, y = z_prices) ), grid_pric()), color = I("green"), name = "original")
    fig <- fig %>% add_trace(x = grid_pric()$x, y = predict(model(), grid_pric()), color = I("red"), mode = "markers+lines", name = "scenario")
    fig <- fig %>% layout(shapes = circles) %>% config(edits = list(shapePosition = TRUE))
    fig
    
    
    })
  
  output$summary_pric <- renderPrint({a
    #    summary(model())
    z_curve
  })
  
  # update x/y reactive values in response to changes in shape anchors
  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_pric$x[row_index] <- pts[1]
    rv_pric$y[row_index] <- pts[2]
  })

  ####################### PRICES - END #######################  
  
  
  ####################### VOLATILITIES - START #######################  
  rv_vola <- reactiveValues(
    x = z_months,
    y = z_volas
  )
  grid_vola <- reactive({
    data.frame(x = seq(min(rv_vola$x), max(rv_vola$x), length = 10))
  })
  
  model <- reactive({
    d <- data.frame(x = rv_vola$x, y = rv_vola$y)
    loess(y ~ x, d)
  })
  
  
  output$p_vola <- renderPlotly({
    # creates a list of circle shapes from x/y data
    circles <- map2(rv_vola$x, rv_vola$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() %>%
      add_markers(x = z_months, y = z_volas, color = I("green"), name = "volatilies") 
    fig <- fig %>%  add_lines(x = grid_vola()$x, y = predict(loess(y ~ x, data.frame(x = z_months, y = z_volas) ), grid_vola()), color = I("green"), name = "original")
    fig <- fig %>% add_trace(x = grid_vola()$x, y = predict(model(), grid_vola()), color = I("red"), mode = "markers+lines", name = "scenario")
    fig <- fig %>% layout(shapes = circles) %>% config(edits = list(shapePosition = TRUE))
    fig
    
    
  })
  
  output$summary_vola <- renderPrint({a
    #    summary(model())
    z_curve
  })
  
  # update x/y reactive values in response to changes in shape anchors
  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_vola$x[row_index] <- pts[1]
    rv_vola$y[row_index] <- pts[2]
  })

  ####################### VOLATILITIES - END #######################  
  
  
    
  
  
  
  
  
    
}

shinyApp(ui, server)

This repeated code each which update a chart is listening to all chart updates rather than to changes to a particular chart. You will need to first name the plotly charts with the source param, and then change each of these observes over event_data's to listen to specific source's only.

 observe({
    ed <- event_data("plotly_relayout",
                      source="firstchart")

add a source = param here to pick out exactly which chart each of these source be listening to and name the charts by adding source param when you create them

 fig <- plot_ly() %>%
 fig <- plot_ly(source="firstchart") %>%
1 Like

Outstanding! Thank you very much.