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)