Search code examples
rshinyobserversshiny-reactivity

How to replace an observeEvent with a more comprehensive reactive function in R Shiny?


The code at the bottom of this post works as intended, using observeEvent(input$choices...) in the server section. The use of input$choices is a simplification for sake of example ease. In the fuller code this excerpt derives from, the equivalent of "choices" is molded by many different inputs (call it a "floating reactive"), and unless I misunderstand observeEvent(), it won't be feasible to use observeEvent() in the fuller code because I would have to list the myriad inputs that can alter it. So, is there a way to genericize this code where it instantly captures any change to "choices" (again, "choices" is a simplified analogy for my more complex floating reactive) and outputs it to the 2nd row of the table, including added rows?

Also in the below image, I show how "choices" is a always parachuted into the 2nd position of the dataframe in all circumstances (maybe there's a simpler way to do this too):

enter image description here

Code:

library(rhandsontable)
library(shiny)

mydata <- data.frame('Series 1' = c(1,1,0,1), check.names = FALSE)
rownames(mydata) <- c('Term A','Floating reactive','Term C','Term D') 

ui <- fluidPage(br(),
  useShinyjs(), 
  uiOutput("choices"),br(),
  rHandsontableOutput('hottable'),br(),
  fluidRow(
    column(1,actionButton("addSeries", "Add",width = '70px')),
    column(3,hidden(uiOutput("delSeries2"))) 
  )
)

server <- function(input, output) {
  uiTable <- reactiveVal(mydata)
  
  observeEvent(input$hottable, {uiTable(hot_to_r(input$hottable))})
  
  output$hottable <- renderRHandsontable({
    rhandsontable(uiTable(),rowHeaderWidth = 100, useTypes = TRUE)
  })
  
  observeEvent(input$choices,{
    tmpTable <- uiTable()
    tmpTable[2,]<- as.numeric(input$choices)
    uiTable(tmpTable)
  })
  
  output$choices <- 
    renderUI({
      selectInput(
        "choices", 
        label = "User selects value to reflect in row 2 of table below:",
        choices = c(1,2,3)
      )
    })
  
  observeEvent(input$addSeries, {
    newCol <- data.frame(c(1,1,0,1)) 
    newCol[2,] <- as.numeric(input$choices) 
    names(newCol) <- paste("Series", ncol(hot_to_r(input$hottable)) + 1)
    uiTable(cbind(uiTable(), newCol))
  })
 
  output$delSeries2 <- 
    renderUI(
      selectInput(
        "delSeries3", 
        label = NULL,
        choices = colnames(hot_to_r(input$hottable))
      )
    )

}

shinyApp(ui,server)

Solution

  • Not sure if I get the point here, but you might want to use observe instead of observeEvent to avoid managing the reactive dependencies (eventExpr) yourself:

    library(rhandsontable)
    library(shiny)
    library(shinyjs)
    
    mydata <- data.frame('Series 1' = c(1,1,0,1), check.names = FALSE)
    rownames(mydata) <- c('Term A','Floating reactive','Term C','Term D') 
    
    ui <- fluidPage(br(),
                    useShinyjs(), 
                    uiOutput("choices"),br(),
                    rHandsontableOutput('hottable'),br(),
                    fluidRow(
                      column(1,actionButton("addSeries", "Add",width = '70px')),
                      column(3,hidden(uiOutput("delSeries2"))) 
                    )
    )
    
    server <- function(input, output) {
      uiTable <- reactiveVal(mydata)
      
      observeEvent(input$hottable, {uiTable(hot_to_r(input$hottable))})
      
      output$hottable <- renderRHandsontable({
        rhandsontable(uiTable(),rowHeaderWidth = 100, useTypes = TRUE)
      })
      
      observe({
        req(input$choices)
        tmpTable <- uiTable()
        tmpTable[2,] <- as.numeric(input$choices)
        uiTable(tmpTable)
      })
      
      output$choices <- 
        renderUI({
          selectInput(
            "choices", 
            label = "User selects value to reflect in row 2 of table below:",
            choices = c(1,2,3)
          )
        })
      
      observeEvent(input$addSeries, {
        newCol <- data.frame(c(1,1,0,1)) 
        newCol[2,] <- as.numeric(input$choices) 
        names(newCol) <- paste("Series", ncol(hot_to_r(input$hottable)) + 1)
        uiTable(cbind(uiTable(), newCol))
      })
      
      output$delSeries2 <- 
        renderUI(
          selectInput(
            "delSeries3", 
            label = NULL,
            choices = colnames(hot_to_r(input$hottable))
          )
        )
      
    }
    
    shinyApp(ui,server)