I am trying to eliminate some points from a plotly graph by clicking on them, the code I have works perfectly, however when applying a filter before the process and returning the input data frame a reactive object throws me the following error:
Warning: Error in : Operation not allowed without an active reactive context.
* You tried to do something that can only be done from inside a reactive consumer.
What I understand is that within a reactiveValues there cannot be a reactive object, but I need it to be reactive because it depends on some filters that the user would make.
Below I present the code, I would appreciate any guidance. Thanks!!
library(shiny)
library(plotly)
library(dplyr)
n <- 20
df <- data.frame(
date = seq.Date(as.Date("01/01/2000", format = "%d/%m/%Y"), length.out = 20, by = "quarter"),
cat = sample(paste0("cat",1:3), n, replace = TRUE),
filter1 = sample(paste0("f",1:2),n, replace = TRUE),
var2 = runif(n,-10,10),
var3 = c(1:n)^2,
INDEX = 1:20
)
limits <- data.frame(limits = paste0("limit",1:3),
limit.value = c(-1,2,-3))
ui <- fluidPage(
selectInput("var","select var", names(df)[4:5]),
selectInput("cat","select cat", unique(df$cat),unique(df$cat)[1] ,multiple = TRUE),
checkboxGroupInput("f","filter", c("f1","f2"), "f1"),
verbatimTextOutput("print"),
mainPanel(plotlyOutput("plot")),
verbatimTextOutput("selection"),
# eliminar puntos seleccionados
actionButton("delete","Delete", style = "display:inline-block;"),
# restaurar seleccion (antes de eliminar)
actionButton("reset","Reset", style = "display:inline-block;"),
# Restaurar puntos elminados
actionButton("reset_all","Reset all", style = "display:inline-block;")
)
server <- function(input, output, session) {
df <- reactive({
df %>% filter(filter1 %in% input$f)
})
df_backup <- df()
myData <- reactiveValues(df = df())
output$plot <- renderPlotly({
p0 <- list()
g0 <- c()
for(i in 1:length(input$cat)){
g <- myData$df %>%
filter(cat %in% input$cat[i]) %>%
plot_ly(x = ~date,
y = ~get(input$var),
type = "scatter",
mode = 'lines+markers',
name = ~cat,
source = "A",
text = ~cat,
key = ~INDEX)
g0 <- rbind(g0, paste0("g",i))
p0[[paste("g",i)]] <- g
}
t2 <- tibble(x = g0,
p = p0 )
t2 %>%
subplot(nrows = 1,
shareX = FALSE,
shareY = TRUE,
margin = 0.0001)
})
# Acumular clicks
p1 <- reactive({
event_data("plotly_click", source = "A")
})
p2 <- reactiveValues(points = c())
observeEvent(p1(),{
p2$points <- c(p2$points,as.list(p1())$key[[1]])
})
observeEvent(input$reset,{
p2$points <- c()
})
output$selection <- renderPrint({
if(length(p2$points)<1){"Select data points to delete"}else{(p2$points)}
#as.list(p1())$key[[1]]
#matrix(p2$points, ncol = 2, byrow = TRUE)
})
# filtro de los puntos seleccionados
observeEvent(input$delete,{
# browser()
myData$df <- myData$df %>%
mutate(delete = ifelse(INDEX %in% c(p2$points),TRUE,FALSE)) %>%
filter(!delete)
# And clear input?
p2$points <- c()
})
observeEvent(input$reset_all,{
# browser()
myData$df <- df_backup
})
}
shinyApp(ui, server)
You can use isolate to access the reactive:
library(shiny)
library(plotly)
library(dplyr)
n <- 20
DF <- data.frame(
date = seq.Date(
as.Date("01/01/2000", format = "%d/%m/%Y"),
length.out = 20,
by = "quarter"
),
cat = sample(paste0("cat", 1:3), n, replace = TRUE),
filter1 = sample(paste0("f", 1:2), n, replace = TRUE),
var2 = runif(n, -10, 10),
var3 = c(1:n) ^ 2,
INDEX = 1:20
)
limits <- data.frame(limits = paste0("limit", 1:3),
limit.value = c(-1, 2, -3))
ui <- fluidPage(
selectInput("var", "select var", names(df)[4:5]),
selectInput("cat", "select cat", unique(df$cat), unique(df$cat)[1] , multiple = TRUE),
checkboxGroupInput("f", "filter", c("f1", "f2"), "f1"),
verbatimTextOutput("print"),
mainPanel(plotlyOutput("plot")),
verbatimTextOutput("selection"),
# eliminar puntos seleccionados
actionButton("delete", "Delete", style = "display:inline-block;"),
# restaurar seleccion (antes de eliminar)
actionButton("reset", "Reset", style = "display:inline-block;"),
# Restaurar puntos elminados
actionButton("reset_all", "Reset all", style = "display:inline-block;")
)
server <- function(input, output, session) {
myData <- reactiveValues(df = NULL)
observeEvent(input$f, {
myData$df <- DF %>% filter(filter1 %in% input$f)
})
df_backup <- DF %>% filter(filter1 %in% isolate(input$f))
output$plot <- renderPlotly({
req(myData$df)
p0 <- list()
g0 <- c()
for (i in 1:length(input$cat)) {
g <- myData$df %>%
filter(cat %in% input$cat[i]) %>%
plot_ly(
x = ~ date,
y = ~ get(input$var),
type = "scatter",
mode = 'lines+markers',
name = ~ cat,
source = "A",
text = ~ cat,
key = ~ INDEX
)
g0 <- rbind(g0, paste0("g", i))
p0[[paste("g", i)]] <- g
}
t2 <- tibble(x = g0,
p = p0)
t2 %>%
subplot(
nrows = 1,
shareX = FALSE,
shareY = TRUE,
margin = 0.0001
)
})
# Acumular clicks
p1 <- reactive({
event_data("plotly_click", source = "A")
})
p2 <- reactiveValues(points = c())
observeEvent(p1(), {
p2$points <- c(p2$points, as.list(p1())$key[[1]])
})
observeEvent(input$reset, {
p2$points <- c()
})
output$selection <- renderPrint({
if (length(p2$points) < 1) {
"Select data points to delete"
} else{
(p2$points)
}
# as.list(p1())$key[[1]]
# matrix(p2$points, ncol = 2, byrow = TRUE)
})
# filtro de los puntos seleccionados
observeEvent(input$delete, {
# browser()
myData$df <- myData$df %>%
mutate(delete = ifelse(INDEX %in% c(p2$points), TRUE, FALSE)) %>%
filter(!delete)
# And clear input?
p2$points <- c()
})
observeEvent(input$reset_all, {
# browser()
myData$df <- df_backup
})
}
shinyApp(ui, server)