如何为模态对话框中呈现的对象运行观察函数？

Posted 2023-03-24

【中文标题】如何为模态对话框中呈现的对象运行观察函数？

【英文标题】：How to run an observe function for an object rendered in modal dialog?

【发布时间】：2021-12-27 09:53:57

【问题描述】：

进一步说明：取消注释observe() 部分并在input$periods 下面插入req(input$matrix2) 似乎有效，除非用户在输入matrix2 后更改input$periods，在这种情况下input$periods 限制被忽略。

在下面的代码中，我尝试运行 modalDialog() 中呈现的 matrix2 的注释掉的 observe() 函数。 Observe() 应该在输入 $periods 处限制 matrix2 左列中元素的值。我尝试将这个 observe() 放在模态框内，但它不起作用。当在没有modalDialog() 的UI 部分中呈现matrix2 时，此observe() 运行良好。但我想在 modalDialog 中使用 matrix2。有没有办法将 observe() 放在 modalDialog() 中？或者还有其他方法可以运行这个observe() 功能吗？

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

interpol <- function(a, b)  # a = periods, b = matrix inputs
  c <- rep(NA, a)
  c[1] <- b[1]
  c[a] <- b[2]
  c <- approx(seq_along(c)[!is.na(c)], c[!is.na(c)], seq_along(c))$y # << interpolates
  return(c)


ui <- fluidPage(
  
  sidebarLayout(
    sidebarPanel(
      sliderInput('periods', 'Modeled periods (X variable):', min=1, max=10, value=10),
      matrixInput("matrix1", 
                  label = "Matrix 1",
                  value = matrix(c(5), ncol = 1, dimnames = list("Base rate",NULL)),
                  cols =  list(names = FALSE),
                  class = "numeric"),
      
      actionButton("matrix2show","Add scenarios (via Matrix 2)",width = "100%")
    ),
    mainPanel(
      plotOutput("plot")
    )  
  )    
)

server <- function(input, output, session)
  
  # observe( 
  #   input$periods
  #   tmpMat2 <- input$matrix2
  #   tmpMat2[,c(TRUE, FALSE)] <- apply(tmpMat2[,c(TRUE, FALSE),drop=FALSE], 2,
  #                                     function(x) pmin(x, input$periods))
  #   updateMatrixInput(session,
  #                     inputId="matrix2",
  #                     value=tmpMat2
  #   )
  # )
  
  observeEvent(input$matrix1, 
    tmpMat2 <- c(input$matrix2[,1],input$matrix2[,2]) # convert to vector
    tmpMat2[length(input$matrix2)/2+1] <- input$matrix1[,1] # drop matrix 1 value into row 1/col 2 of matrix 2
    updateMatrixInput(session,
                      inputId="matrix2",
                      value=matrix(tmpMat2,ncol=2,dimnames=list(NULL,c("X","Y")))
    )
  )
  
  observeEvent(input$matrix2show,
    showModal(
      modalDialog(
          matrixInput("matrix2",
                      label = "Matrix 2 (will link to Matrix 1)",
                      value = if(is.null(input$matrix2))
                                 matrix(c(10,5), ncol = 2, dimnames = list(NULL,c("X","Y")))
                              else input$matrix2,
                      rows = list(extend = TRUE, delete = TRUE),
                      class = "numeric"),
          footer = modalButton("Close")
      ))
  )
  
  plotData <- reactive(
    tryCatch(
      tibble(
        X = seq_len(input$periods),
        Y = if(isTruthy(input$matrix2))interpol(input$periods,input$matrix2)
            else input$matrix1
      ),
      error = function(e) NULL
    )
  )
  
  output$plot <- renderPlot(
    req(plotData())
    plotData() %>% ggplot() + 
      geom_line(aes(x = X, y = Y)) +
      theme(legend.title=element_blank())
  )


shinyApp(ui, server)

【参考方案1】：

您需要确保input$matrix2 不为NULL。这可以做到，例如使用req:

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

interpol <- function(a, b)  # a = periods, b = matrix inputs
  c <- rep(NA, a)
  c[1] <- b[1]
  c[a] <- b[2]
  c <- approx(seq_along(c)[!is.na(c)], c[!is.na(c)], seq_along(c))$y # << interpolates
  return(c)


ui <- fluidPage(
  
  sidebarLayout(
    sidebarPanel(
      sliderInput('periods', 'Modeled periods (X variable):', min=1, max=10, value=10),
      matrixInput("matrix1", 
                  label = "Matrix 1",
                  value = matrix(c(5), ncol = 1, dimnames = list("Base rate",NULL)),
                  cols =  list(names = FALSE),
                  class = "numeric"),
      
      actionButton("matrix2show","Add scenarios (via Matrix 2)",width = "100%")
    ),
    mainPanel(
      plotOutput("plot")
    )  
  )    
)

server <- function(input, output, session)
  
  observeEvent(c(input$matrix2show, input$matrix2), 
    tmpMat2 <- req(input$matrix2)
    tmpMat2[,c(TRUE, FALSE)] <- apply(tmpMat2[,c(TRUE, FALSE), drop=FALSE], 2,
                                      function(x) pmin(x, input$periods))
    updateMatrixInput(session,
                      inputId="matrix2",
                      value=tmpMat2
    )
  )
  
  observeEvent(input$matrix1, 
    tmpMat2 <- c(input$matrix2[,1],input$matrix2[,2]) # convert to vector
    tmpMat2[length(input$matrix2)/2+1] <- input$matrix1[,1] # drop matrix 1 value into row 1/col 2 of matrix 2
    updateMatrixInput(session,
                      inputId="matrix2",
                      value=matrix(tmpMat2,ncol=2,dimnames=list(NULL,c("X","Y")))
    )
  )
  
  observeEvent(input$matrix2show,
    showModal(
      modalDialog(
        matrixInput("matrix2",
                    label = "Matrix 2 (will link to Matrix 1)",
                    value = if(is.null(input$matrix2))
                      matrix(c(10,5), ncol = 2, dimnames = list(NULL,c("X","Y")))
                    else input$matrix2,
                    rows = list(extend = TRUE, delete = TRUE),
                    class = "numeric"),
        footer = modalButton("Close")
      ))
  )
  
  plotData <- reactive(
    tryCatch(
      tibble(
        X = seq_len(input$periods),
        Y = if(isTruthy(input$matrix2))interpol(input$periods,input$matrix2)
        else input$matrix1
      ),
      error = function(e) NULL
    )
  )
  
  output$plot <- renderPlot(
    req(plotData())
    plotData() %>% ggplot() + 
      geom_line(aes(x = X, y = Y)) +
      theme(legend.title=element_blank())
  )


shinyApp(ui, server)

【讨论】：

谢谢你，ismirsehregal！现在，当输入到 matrix2 后 input$periods 减少时，我试图将 input$periods 限制施加到 matrix2 的左列。当我在 UI 下使用 matrix2 时，它也适用于这种情况。顺便说一句，我完全根据您之前的建议从 renderUI 进行了切换，我对此感到非常满意，我发现代码现在更容易理解了。

请看我的编辑。我切换到observeEvent 监听input$matrix2show 和input$matrix2 的变化。对input$periods 的更改做出反应是没有用的，因为当input$periods 更改时矩阵2 输入不存在。很高兴听到您没有renderUI 就成功了！

是的，效果很好。很遗憾看到observe() 消失，因为最后，通过这个练习，我看到并理解了observe() 和observeEvent() 之间的区别。但你是对的，因为有一个触发模态的特定事件，其中 observeEvent() 有意义。

还有你的 observeEvent() 观察 2 个对象的变化：非常有用的一课，我以前没见过