In R Shiny, how to replace observeEvent with observe?

Viewed 306

The following almost-MWE code links user inputs into three objects using observeEvent. The image at the bottom also shows and explains these three objects:

  1. First object is a slider input for number of modeled periods, called variable X.

  2. Second object is a 1x1 matrix where the user inputs a single variable Y.

  3. Third object is a vertically expandable matrix where the user inputs a series of values X|Y.

The calculation underlying the plot is a simple sum product, used as a placeholder simplification for this MWE.

User input linkages are shown in the image at the bottom.

How would I replace the two observeEvents used in MWE below with an observe in each case? If possible. (I believe this will offer a solution to another issue I'm having, based on my research of what the observe function does). I've only used observeEvents in my limited Shiny experience.

MWE code:

library(dplyr)
library(ggplot2)
library(shiny)
library(shinyMatrix)

sumProd <- function(a, b) {
  c    <- rep(NA, a)
  c[]  <- sum(b[,1], na.rm = T) %*% sum(b[,2],na.rm = T) 
  return(c)
}

ui <- fluidPage(
  sliderInput('periods', 'Modeled periods (X):', min=1, max=10, value=10),
  matrixInput("matrix1", 
              value = matrix(c(5), nrow = 1, ncol = 1, dimnames = list("Base rate (Y)",NULL)),
              cols =  list(names = FALSE),
              class = "numeric"),
  matrixInput("matrix2",
              value = matrix(c(10,5), nrow = 1, ncol = 2, dimnames = list(NULL,c("X","Y"))),
              rows = list(extend = TRUE, delete = TRUE),
              class = "numeric"),
  plotOutput("plot")
)

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

  observeEvent(input$periods,{
    updateMatrixInput(
      session, inputId = "matrix2", 
      value = matrix(c(input$periods,input$matrix2[1,2]),1,2,dimnames=list(NULL,c("X","Y")))
    )
  })
  
  observeEvent(input$matrix1, {
    tmpMat2 <- c(input$matrix2[,1],input$matrix2[,2])
    tmpMat2[length(input$matrix2)/2+1] <- input$matrix1[,1]
    updateMatrixInput(session,inputId="matrix2",value=matrix(tmpMat2,ncol=2,dimnames=list(NULL,c("X","Y")))
    )
  })
  
  plotData <- reactive({
    tryCatch(
      lapply(seq_len(ncol(input$matrix2)/2), # column counter to set matrix index as it expands
             function(i){
               tibble(
                 Scenario = colnames(input$matrix2)[i*2-1],
                 X = seq_len(input$periods),
                 Y = sumProd(input$periods,input$matrix2[,(i*2-1):(i*2), drop = FALSE])
               )
             }) %>% bind_rows(),
      error = function(e) NULL
    )
  })
  
  output$plot <- renderPlot({
    req(plotData())
    plotData() %>% ggplot() + 
      geom_line(aes(x = X, y = Y, colour = as.factor(Scenario))) +
      theme(legend.title=element_blank())
  })
}

shinyApp(ui, server)

Image showing user input linkages among the 3 objects:

enter image description here

1 Answers

I reviewed the post How to listen for more than one event expression within a Shiny observeEvent, which does a nice job of illustrating the interchangeability, in certain circumstances, of observe and observeEvent. Based on that post, I came up with the following substitutions of observeEvent with observe:

sumProd <- function(a, b) {
  c    <- rep(NA, a)
  c[]  <- sum(b[,1], na.rm = T) %*% sum(b[,2],na.rm = T) 
  return(c)
}

ui <- fluidPage(
  sliderInput('periods', 'Modeled periods (X):', min=1, max=10, value=10),
  matrixInput("matrix1", 
              value = matrix(c(5), nrow = 1, ncol = 1, dimnames = list("Base rate (Y)",NULL)),
              cols =  list(names = FALSE),
              class = "numeric"),
  matrixInput("matrix2",
              value = matrix(c(10,5), nrow = 1, ncol = 2, dimnames = list(NULL,c("X","Y"))),
              rows = list(extend = TRUE, delete = TRUE),
              class = "numeric"),
  plotOutput("plot")
)

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

  observe({
    input$periods
    if(input$periods!=0){
      isolate(
        updateMatrixInput(
          session, inputId = "matrix2",
          value = matrix(c(input$periods,input$matrix2[1,2]),1,2,dimnames=list(NULL,c("X","Y")))
          )
      )
    }
  })

  observe({
    input$matrix1
    if(input$matrix1!=0){
      tmpMat2 <- c(input$matrix2[,1],input$matrix2[,2])
      tmpMat2[length(input$matrix2)/2+1] <- input$matrix1[,1]
      isolate(
        updateMatrixInput(
          session,inputId="matrix2",
          value=matrix(tmpMat2,ncol=2,dimnames=list(NULL,c("X","Y")))
          )
      )
    }
  })
  
  plotData <- reactive({
    tryCatch(
      lapply(seq_len(ncol(input$matrix2)/2), # column counter to set matrix index as it expands
             function(i){
               tibble(
                 Scenario = colnames(input$matrix2)[i*2-1],
                 X = seq_len(input$periods),
                 Y = sumProd(input$periods,input$matrix2[,(i*2-1):(i*2), drop = FALSE])
               )
             }) %>% bind_rows(),
      error = function(e) NULL
    )
  })
  
  output$plot <- renderPlot({
    req(plotData())
    plotData() %>% ggplot() + 
      geom_line(aes(x = X, y = Y, colour = as.factor(Scenario))) +
      theme(legend.title=element_blank())
  })
}

shinyApp(ui, server)
Related