Using reactive conditions inside an eventReactive - r

Question

I am building a Shiny app which generates a dataframe through a specific function. I want to use an eventReactive() to attribute the result of this function depending on a reactive input.
I tried to follow this answer : Working with a reactive() dataframe inside eventReactive()? but when I want to use an observeEvent, it always generate an error Warning: Error in $.shinyoutput: Reading objects from shinyoutput object not allowed.
My first try was as follows with an example :
DATA and LIBRAIRIES
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
df <- data.frame(c1 = c(rep("A", 3), rep("B", 4), "on"),
c2 = 1:8,
c3 = c(2002,2003,2002,2004,2002,2003,2005, 2005))
my_function <- function(arg1, arg2)
{
df = data.frame(
v1 = mean(df %>% filter(c1 == arg1) %>% select(c2) %>% pull()),
v2 = arg2
)
return(df)
}
UI
ui <- fluidPage(
selectInput(inputId = "input1", label = NULL,
choices = c("A", "B"),
selected = "A"),
selectInput(inputId = "input2", label = NULL,
choices = c("on", "off"),
selected = "on"),
uiOutput("ui_year"),
uiOutput("fct_extract"),
actionButton(inputId = "extraction", label = "Go", icon = icon("play")),
uiOutput("col_visu")
)
SERVER
server <- function(input, output) {
output$ui_year <- renderUI({
checkboxGroupInput(inputId = "year1", label = NULL, choices = df %>% filter(c1 == "A") %>% select(c3) %>% pull())
})
output$fct_extract <- renderUI({
shinyWidgets::radioGroupButtons(
inputId = "fct_extract",
label = NULL,
selected = "B1",
choices = c("B0", "B1"),
status = "warning")
})
fct_extr <- reactive(output$fct_extract)
df2 <- eventReactive(input$extraction, {
if (fct_extr() == "B0")
{
my_function(arg1 = input$input1,
arg2 = input$input1)
} else if (fct_extr() == "B1")
{
my_function(arg1 = input$input2,
arg2 = input$input1)
}
})
columns <- reactive(colnames(df2()))
output$col_visu <- renderUI({
shinyWidgets::multiInput(
inputId = "col_visu", width = "400px",
label = h2("Selection :"),
choices = columns())
})
}
When I put the actionButton, it generates the message : Reading objects from shinyoutput object not allowed. and nothing else happened
So I tried in the SERVER :
fct_extr <- reactive(output$fct_extract)
df2 <- observeEvent(input$extraction, {
if (fct_extr() == "B0")
{
my_function(arg1 = input$input1,
arg2 = input$input1)
} else if (fct_extr() == "B1")
{
my_function(arg1 = input$input2,
arg2 = input$input1)
}
})
}
Here I got the message : argument "x" is missing, with no default instead of the result of col_visu and when I put the actionButton, the app closed
In addition, when I don't try to add the choice with fct_extra, it works :
df2 <- eventReactive(input$extraction, {
my_function(arg1 = input$input1,
arg2 = input$input1)
})
columns <- reactive(colnames(df2()))
output$col_visu <- renderUI({
shinyWidgets::multiInput(
inputId = "col_visu", width = "400px",
label = h2("Selection :"),
choices = columns())
})
Thank you to the one of you who will explain how to include a reactive inside an eventReactive :)

Answer 1

You define the following dynamic radioGroupButton:
output$fct_extract <- renderUI({
shinyWidgets::radioGroupButtons(
inputId = "fct_extract",
label = NULL,
selected = "B1",
choices = c("B0", "B1"),
status = "warning")
})
This defines a UI element whose value is accessible in input with the key set to the element's inputId. So, in this case, the value is under input$fct_extract
Note that this is independent of the name of your UI object in the output, which just happens to also be fct_extract. This naming is confusing and probably caused your error: trying to access the value of the widget in output$fct_extract when it is actually in input$fct_extract.
To fix your code, replace the illegal line (fct_extr <- reactive(output$fct_extract)) with the correct:
fct_extr <- reactive(input$fct_extract)
In fact, this reactive is redundant since input$fct_extract is already a reactive value. So just ditch your reactive entirely and use input$fct_extract (without brackets) where you would have used fct_extr()

Answer 2

I made a few edits to your code to get it working. Here are the actual code changes though for your question:
mean(df... instead of mean(a...
my_function <- function(arg1, arg2)
{
df = data.frame(
v1 = mean(df %>% filter(c1 == arg1) %>% select(c2) %>% pull()),
v2 = arg2
)
return(df)
}
and then removing the line fct_extr <- reactive(output$fct_extract). I think you meant to use reactiveVal but it's unnecessary here. I just replaced:
if (fct_extr() == "B0")... else if (fct_extr() == "B1") with
if (input$fct_extr == "B0")... else if (input$fct_extr == "B1")
Full code below.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
df <- data.frame(c1 = c(rep("A", 3), rep("B", 4), "on"),
c2 = 1:8,
c3 = c(2002,2003,2002,2004,2002,2003,2005, 2005))
my_function <- function(arg1, arg2)
{
df = data.frame(
v1 = mean(df %>% filter(c1 == arg1) %>% select(c2) %>% pull()),
v2 = arg2
)
return(df)
}
ui <- fluidPage(
selectInput(inputId = "input1", label = NULL,
choices = c("A", "B"),
selected = "A"),
selectInput(inputId = "input2", label = NULL,
choices = c("on", "off"),
selected = "on"),
uiOutput("ui_year"),
uiOutput("fct_extract"),
actionButton(inputId = "extraction", label = "Go", icon = icon("play")),
uiOutput("col_visu")
)
server <- function(input, output) {
output$ui_year <- renderUI({
checkboxGroupInput(inputId = "year1", label = NULL, choices = df %>% filter(c1 == "A") %>% select(c3) %>% pull())
})
output$fct_extract <- renderUI({
shinyWidgets::radioGroupButtons(
inputId = "fct_extract",
label = NULL,
selected = "B1",
choices = c("B0", "B1"),
status = "warning")
})
# fct_extr <- reactiveVal(input$fct_extract)
df2 <- eventReactive(input$extraction, {
if (input$fct_extract == "B0")
{
my_function(arg1 = input$input1,
arg2 = input$input1)
} else if (input$fct_extract == "B1")
{
my_function(arg1 = input$input2,
arg2 = input$input1)
}
})
columns <- reactive(colnames(df2()))
output$col_visu <- renderUI({
shinyWidgets::multiInput(
inputId = "col_visu", width = "400px",
label = h2("Selection :"),
choices = columns())
})
}
shinyApp(ui, server)