CODEWITHSUNDEEP
rshiny
Cha
Cha

Reputation: 39

How to put 2 possibles eventReactive in only one variable

I am building a Shiny app which generate a dataframe from a database through the specific function my_function. I want to use an eventReactive() to attribute the result of my_function depending on different inputs. My problem is that there are 2 ways to select these inputs which are structured in 2 different panels (I need this structure), so I have 2 actionButton that allow me to run my_function, and 1 variable for each eventReactive. Is there a way to put them in only 1 variable ?

df_all is a dataframe with several columns like "VAR1", "YEAR", "TYPE", "AGE" ... I need to filter depending on the inputs.

For the moment I have tried :

library(shiny)
library(shinydashboard)
library(DT)
library(dplyr)


df_all <- data.frame(
  VAR1 = c(rep("A", 2), "B", "C")
  YEAR = (rep(2001, 3), 2002)
  TYPE = c("t1", "t2", "t2", "t1")
)

my_function <- function(arg1, arg2, arg3)
{
  df = data.frame(
    v1 = paste(arg1, arg2)
    v2 = arg3
  )
  return(df)
}

shinyUI(dashboardPage(

  dashboardHeader("title"),

  dashboardSidebar(
    sidebarMenu(id = "menu",
      menuItem("Item1", tabName = "item1")
  )),

  dashboardBody( 
    tabItems(
      tabItem(tabName = "item1",
        selectInput(inputId = "var1", label = NULL, choices = c("A", "B", "C")),

        tabsetPanel(
          tabPanel("Item1-Panel1",
          uiOutput("ui_year1"),
          uiOutput("ui_type1"),
          div(actionButton(inputId = "extra1", label = "Run", icon = icon("play")))),

          tabPanel("Item1-Panel2",
          uiOutput("ui_year2"),
          uiOutput("ui_type2"),
          div(actionButton(inputId = "extra2", label = "Run", icon = icon("play")))),

          tabPanel("Item1-Panel3",
              DT::dataTableOutput("tableau_ext1"),
              DT::dataTableOutput("tableau_ext2"),
              downloadButton("downloadCSV", "Save (CSV)"))
))))))


shinyServer(function(input, output) {

  output$ui_year1 <- renderUI({
    checkboxGroupInput(inputId = "year1", label = NULL, choices = df_all %>% filter(CULTURE == input$var1) %>% select(YEAR) %>% distinct() %>% pull()
  })
  output$ui_type1 <- renderUI({
    checkboxGroupInput(inputId = "type1", label = NULL, choices = sort(df_all %>% filter(VAR1 == input$cult, YEAR %in% input$year1) %>% select(TYPE) %>% distinct() %>% pull())
  })

  output$ui_year2 <- renderUI({
    checkboxGroupInput(inputId = "year2", label = NULL, choices = df_all %>% filter(VAR1 == input$var1) %>% select(YEAR) %>% distinct() %>% pull()
  })
  output$ui_type2 <- renderUI({
    checkboxGroupInput(inputId = "type2", label = NULL, choices = sort(df_all %>% filter(VAR1 == input$cult, YEAR %in% input$year2) %>% select(TYPE) %>% distinct() %>% pull())
  })

  df1 <- eventReactive(input$extra1, {
    my_function(arg1 = input$cult,
                arg2 = as.numeric(input$year1),
                arg3 = as.character(input$type1)) 
  })
  df2 <- eventReactive(input$extra2, {
    my_function(arg1 = input$cult,
                arg2 = as.numeric(input$year2),
                arg3 = as.character(input$type2)) 
  })
})

I tried to attribute the 2 eventReactive in 1 variable df, because I want to see and save the dataframe generated by my_function with :

shinyServer([...]

 df <- eventReactive(input$extra1, {
    my_function(arg1 = input$cult,
                arg2 = as.numeric(input$year1),
                arg3 = as.character(input$type1)) 
  })

  df <- eventReactive(input$extra2, {
    my_function(arg1 = input$cult,
                arg2 = as.numeric(input$year2),
                arg3 = as.character(input$type2)) 
  })


    output$tableau_ext1 <- DT::renderDataTable({
      df()
    })

    output$downloadCSV <- downloadHandler(
      filename = function() {
        paste0(input$year1, "_", input$type1, ".csv")
      },
      content = function(file) {
        write.csv2(df(), file, row.names = FALSE)
      }
    ) 
)

But it didn't worked... If someone knows how to solve my problem, I will be grateful for his help :)

Upvotes: 0

Views: 337

Answers (1)

teofil
teofil

Reputation: 2394

Building off of this thread the following seems to achieve the desired behavior (if I understand everything correctly):

library(shiny)

my_fun <- function() {
   x <- sample(x=nrow(iris), size = 6)
   x
}

ui <- fluidPage(
    tabsetPanel(
    tabPanel(title = "panel1",
            actionButton("go1", "go 1")),
    tabPanel(title = "panel2",
            actionButton("go2", "go 2"))
    ),
     mainPanel(dataTableOutput("tab"))
    )

server <- function(input, output) {
    df <- eventReactive(c(input$go1, input$go2), {
    iris[my_fun(),]
     }, ignoreNULL = FALSE, ignoreInit = TRUE)

output$tab <- renderDataTable({
    df()
 })
}

shinyApp(ui, server)

See also ?eventReactive for the ignoreNULL and ignoreInit options.

Edit: Two functions, one eventReactive, and keep track of tabs to know what to render.

library(shiny)
library(dplyr)

go1_fun <- function() {
  x <- filter(iris, Species == "setosa") %>% head
  x
}

go2_fun <- function() {
  x <- filter(iris, Species == "virginica") %>% head
  x
}

ui <- fluidPage(
  tabsetPanel(id = "tabs", 
    tabPanel(title = "panel1",
             actionButton("go1", "go 1")),
    tabPanel(title = "panel2",
             actionButton("go2", "go 2"))
  ),
    mainPanel(dataTableOutput("tab"))
  )

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

  df1 <- reactive({
    if (req(input$go1)) {
        x <- go1_fun()
    }
    return(x)
  })

  df2 <- reactive({  
    if (req(input$go2)) {
        x <- go2_fun()
    }
    return(x)
  })

  tab_to_render <- eventReactive(c(input$go1, input$go2), {
    if (input$tabs == "panel1") x <- df1()
    if (input$tabs == "panel2") x <- df2()

    return(x)
  }, ignoreNULL = FALSE, ignoreInit = TRUE)

  output$tab <- renderDataTable({
    tab_to_render()
  })
}

shinyApp(ui, server)

Upvotes: 1

Related Questions