简体   繁体   中英

In R Shiny, why does one observeEvent() nullify another observeEvent()?

In running the below code, observeEvent(input$matrix2, {...}) is nullifying observeEvent(input$matrix1, {...}) . Why is this happening and how do I fix?

Matrix 1 and matrix 2 are linked. Values from matrix 1 downstream to matrix 2 as matrix 2 "Scenario 1", and matrix 2 allows the user to input additional scenarios via horizontally-expanding matrix. Matrix 2 is rendered in modal dialog, after clicking the single action button. The App (plot) works fine when matrix 1 is input into first (plotting user inputs into both matrices 1 and 2 as it should); but when matrix 2 is viewed (with our without any user inputs into the matrix 2) before inputting into matrix 1, then matrix 1 is rendered useless. By useless I mean inputs into matrix 1 are no longer plotted.

Output for illustration purposes is simply the sum of matrix inputs, plotted over 10 periods, per sumMat(...) function.

I've played around with all variations of isolate(...) , req(...) , etc., with no luck so far.

The images at the bottom illustrate the issue: the first 2 images show the App working well when inputting into matrix 1 first; the 3rd images shows the failure when accessing matrix 2 before matrix 1.

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

sumMat <- function(x){return(rep(sum(x,na.rm = TRUE), 10))}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      matrixInput("matrix1",
                  value = matrix(c(60,5), ncol = 2, dimnames = list(NULL,c("X","Y"))),
                  rows = list(extend = TRUE, delete = TRUE), class = "numeric"),
      actionButton("matrix2show","Add scenarios"),
      ),
    mainPanel(plotOutput("plot"))  
  )    
)

server <- function(input, output, session){
  
  observeEvent(input$matrix1, {
    tmpMat1 <- input$matrix1
    if(any(rownames(input$matrix1) == "")){rownames(tmpMat1) <- paste("Row", seq_len(nrow(input$matrix1)))}
    updateMatrixInput(session, inputId = "matrix1", value = tmpMat1)
  })
  
  observeEvent(input$matrix2, { ### updates matrix 2 to reflect larger of matrix 1 and matrix 2 rows
    req(input$matrix1)
    a <- apply(input$matrix2,2,'length<-',max(nrow(input$matrix2),nrow(input$matrix1)))
    b <- apply(input$matrix1,2,'length<-',max(nrow(input$matrix2),nrow(input$matrix1)))
    c <- if(length(a) == 2){c(b)} else {c(b,a[,-1:-2])}
    d <- ncol(input$matrix2)
    
    tmpMat2 <- matrix(c(c), ncol = d)
    tmpMat2[1,2] <- input$matrix1[1,2] 
    colnames(tmpMat2) <- paste("Scenario",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))
    rownames(tmpMat2) <- paste("Row", seq_len(nrow(input$matrix2)))
    
    updateMatrixInput(session,inputId="matrix2",value=tmpMat2)
  })
  
  observeEvent(input$matrix2show,{
    showModal(
      modalDialog(
        matrixInput("matrix2",
                    label = "Matrix 2 (Value Y applied in Period X):",
                    value = if(is.null(input$matrix2))
                    {matrix(c(input$matrix1[,1],input$matrix1[,2]), 
                            ncol = 2, dimnames = list(NULL, rep("Scenario 1", 2)))}
                    else {input$matrix2},
                    rows = list(extend = TRUE, delete = TRUE),
                    cols = list(extend = TRUE, delta = 2, delete = TRUE, multiheader = TRUE),
                    class = "numeric"),
      footer = tagList(modalButton("Exit box"))
      ))
  })
  
  plotData <- reactive({
    tryCatch(
      if(isTruthy(input$matrix2)){
        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(10),Y = sumMat(input$matrix2[,(i*2-1):(i*2), drop = FALSE]))
               }) %>% bind_rows()
        }
      else {tibble(Scenario = "Scenario 1", X = seq_len(10),Y = sumMat(input$matrix1))},
      error = function(e) NULL)
  })
  
  output$plot <- renderPlot({
    req(plotData())
    plotData() %>% ggplot() + geom_line(aes(x = X, y = Y, colour = as.factor(Scenario)))
  })
}

shinyApp(ui, server)

在此处输入图像描述

在此处输入图像描述

在此处输入图像描述

This is a partial solution. Each time you click on the actionButton, you are creating the same ID for matrix2. That is a problem as Shiny requires unique ID. Once we adjust for that, it works fine. See below. You still need to work on how to display the previous columns of input$matrix2. Also, it does not work if you skip matrix1.

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

sumMat <- function(x){return(rep(sum(x,na.rm = TRUE), 10))}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      matrixInput("matrix1",
                  value = matrix(c(60,5), ncol = 2, dimnames = list(NULL,c("X","Y"))),
                  rows = list(extend = TRUE, delete = TRUE),
                  class = "numeric"),
      actionButton("matrix2show","Add scenarios"),
    ),
    mainPanel(plotOutput("plot"))  
  )    
)

server <- function(input, output, session){
  rv <- reactiveValues(tmpMat=NULL)
  observeEvent(input$matrix1, {
    if(any(rownames(input$matrix1) == "")){
      tmpMat1 <- input$matrix1
      rownames(tmpMat1) <- paste("Row", seq_len(nrow(tmpMat1)))
      updateMatrixInput(session, inputId = "matrix1", value = tmpMat1)
    }
  })
  observe({print(rv$tmpMat)})
  
  observeEvent(input[[paste0("matrix2",input$matrix2show)]], {
    req(input[[paste0("matrix2",input$matrix2show)]])
    req(input$matrix1)
    
    inputmatrix2 <- input[[paste0("matrix2",input$matrix2show)]]
    inputmatrix1 <- input$matrix1

    a <- apply(inputmatrix2,2,'length<-',max(nrow(inputmatrix2),nrow(inputmatrix1)))
    b <- apply(inputmatrix1,2,'length<-',max(nrow(inputmatrix2),nrow(inputmatrix1)))
    c <- if(length(a) == 2){c(b)} else {c(b,a[,-1:-2])}
    d <- ncol(inputmatrix2)

    tmpMat2 <- matrix(c(c), ncol = d)
    tmpMat2[1,2] <- inputmatrix1[1,2] # drop matrix 1 value into row 1/col 2 of matrix 2
    colnames(tmpMat2) <- paste("Scenario",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))
    rownames(tmpMat2) <- paste("Row", seq_len(nrow(inputmatrix2))) # << ISSUE HERE!!

    updateMatrixInput(session,inputId=paste0("matrix2",input$matrix2show),value=tmpMat2 )
    rv$tmpMat <- tmpMat2 ##  just checking...
  })
  

  observeEvent(input$matrix2show,{
    ivalue <- matrix(c(input$matrix1[,1],input$matrix1[,2]), 
                     ncol = 2, dimnames = list(NULL, rep("Scenario 1", 2)))
    showModal(
      modalDialog(
        matrixInput(paste0("matrix2",input$matrix2show),
                    label = "Matrix 2 (Value Y applied in Period X):",
                    value = ivalue,
                    rows = list(extend = TRUE, delete = TRUE),
                    cols = list(extend = TRUE, delta = 2, delete = TRUE, multiheader = TRUE),
                    class = "numeric"),
        footer = tagList(modalButton("Exit box"))
      ))
  })
  
  plotData <- reactive({
    req(input$matrix1)
    inputmatrix2 <- input[[paste0("matrix2",input$matrix2show)]]
    tryCatch(
      if(isTruthy(inputmatrix2)){
        lapply(seq_len(ncol(inputmatrix2)/2), # column counter to set matrix index as it expands
               function(i){
                 tibble(Scenario = colnames(inputmatrix2)[i*2-1],
                        X = seq_len(10),
                        Y = sumMat(inputmatrix2[,(i*2-1):(i*2), drop = FALSE])
                 )
               }) %>% bind_rows()
      }
      else {tibble(Scenario = "Scenario 1", X = seq_len(10),Y = sumMat(input$matrix1))},
      error = function(e) NULL
    )
  })
  
  output$plot <- renderPlot({
    req(plotData())
    plotData() %>% ggplot() + geom_line(aes(x = X, y = Y, colour = as.factor(Scenario)))
  })
}

shinyApp(ui, server)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM