use purrr package to create multiple shiny reactive expressions from tibble

Question

tldr: I want to condense multiple reactive expressions (over 300 lines of code) in order to improve readability and maintanability.

I did great upgrades by following this thread and its dependencies. My observers were transformed into observeEvents triggered by FP with the purrr package (way more efficient and easier to read) by means of a tibble created with expand grids to get all my possible inputs (they are close to 120).

The situation now is that I would like to do something similar with my reactive expressions as I did with my observers, one of my issues is that reactive expressions have returns associated with and as long as I know, create stored accesible objects by means of iterarion (vectorization in this case) it is usually not a good practice.

Next I will post a toy example,

library(shiny)

ui <- fluidPage(
    numericInput(inputId = 'a', label = 'a', value = ''),
    numericInput(inputId = 'b', label = 'b', value = ''),
    conditionalPanel(condition = 'output.OK_1',
                    actionButton(inputId = 'ok_btn_1', label = 'OK_1')),
  

    numericInput(inputId = 'c', label = 'c', value = ''),
    numericInput(inputId = 'd', label = 'd', value = ''),
    conditionalPanel(condition = 'output.OK_2',
                     actionButton(inputId = 'ok_btn_2', label = 'OK_2'))

)

server <- function(input, output, session) {
  
#' this are the reactives that I'd like to create by means of FP.
  output$OK_1 <- reactive({req(input$a, input$b)
    if (input$a > input$b) {return(1)} else{return(0)}
    })
  output$OK_2 <- reactive({req(input$c, input$d)
    if (input$c > input$d) {return(1)} else{return(0)}
    })
  
  outputOptions(output, "OK_1", suspendWhenHidden = FALSE)
  outputOptions(output, "OK_2", suspendWhenHidden = FALSE)
}

shinyApp(ui, server)

I thought and try a solution by creating a eventReactive instead of the reactive as the former is powered by the later, and use the eventReactive along with a tibble that contains all my inputs (as I did with the observeEvents) and the purrr::pwalk (maybe here we have a key misconception, since pwalk is used not for returning values but for the side efects of the function/formula. Anyways, I will let it as pwalk until gathering more info). This approach does not work (an example is shown in the next piece of code), so I may be using the wrong function from purrr or maybe I am overkilling it and there is a better way that I am not aware of yet.

unsuccesfull approach (the ui section stays the same):

library(shiny)
library(tibble)
library(purrr)

# variables----
#' defined outside server function
vars <- tibble::tribble(
                        ~x,  ~y,  ~OK,
                        #'---|----|------|
                         'a', 'b', 'OK_1',
                         'c', 'd', 'OK_2'
                        )

#' ui stays the same as before
#'ui <- fluidPage(
#'...
#')

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

    purrr::pwalk(vars,
                ####----
                # 1.. x input 
                # 2.. y input
                # 3.. OK
                ####----
                ~{output[[..3]] <- eventReactive(
                                   if (input[[..1]] > input[[..2]]) {return(1)} else{return(0)},
                                    ignoreInit = TRUE, ignoreNULL = TRUE
                                                 )
                 }
                )

    outputOptions(output, "OK_1", suspendWhenHidden = FALSE)
    outputOptions(output, "OK_2", suspendWhenHidden = FALSE)

}

shinyApp(ui, server)

Any comments or suggestions are welcome.

Answer 1

This worked for me (all objects from your example):

library(purrr)
## ...
    pwalk(vars, ~{
        output[[..3]] <<- reactive({
            req(input[[..1]], input[[..2]])
            return(input[[..1]] > input[[..2]])
        })
    })
# ...

Note the double left assignment <<- needed to address the output which is outside the environment of the function run in pwalk.