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

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

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)

CodePudding user response：

Not sure if I get the point here, but you might want to use observe instead of observeEvent to avoid managing the 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)