0
votes

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 :)

2
Your problem is not using a reactive within an eventReactive. Your issue is trying to read something from output. This is the line causing the error: fct_extr <- reactive(output$fct_extract). Anecdotally, this is exactly what the error message says: Reading objects from shinyoutput object not allowedasachet

2 Answers

0
votes

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()

0
votes

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)