运行 Shiny 脚本时如何在 R Studio 控制台中显示反应矩阵值？

Question

我正在为我昨天的帖子寻找解决方案，in R Shiny, how to move a linked object into modal dialog?。对以下问题的帮助将帮助我找到昨天帖子的可能解决方案。

以下代码按预期工作。矩阵 1 的值位于矩阵 2 的“场景 1”的下游，矩阵 2 允许输入额外的场景，所有场景都绘制为单独的线。但是，我正在尝试将矩阵 1 和矩阵 2 的值实时“反应”地输出到 R Studio 控制台，以便在代码运行时查看矩阵值的情况。在下面的代码中，我用矩阵 2 (tmpMat2) 尝试了这个，但没有成功：所以我在下面的代码中注释了这些行，以便它运行，有人可以帮助我摆脱我发现自己所处的角落。显然，那些被注释掉的行是错误的。

请问，当用户输入矩阵时，如何在 R Studio 控制台中实时显示矩阵 1 (tmpMat1) 和矩阵 2 (tmpMat2) 值？

代码：

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",
                  label ="Matrix 1 (scenario 1):",
                  value = matrix(c(60,5), nrow = 1, ncol = 2, dimnames = list(NULL,c("X","Y"))),
                  rows = list(extend = TRUE, delete = TRUE),
                  class = "numeric"),
      matrixInput("matrix2",
                  label = "Matrix 2:",
                  value = matrix(c(60,5), ncol = 2, dimnames = list(NULL, rep("Scenario 1", 2))),
                  rows = list(extend = TRUE, delete = TRUE),
                  cols = list(extend = TRUE, delta = 2, delete = TRUE, multiheader = TRUE),
                  class = "numeric")
      ),
      mainPanel(plotOutput("plot"))
  )
)

server <- function(input, output, session){
  
  # rv <- reactiveValues(tmpMat=NULL)
  
  observeEvent(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)
    colnames(tmpMat2) <- paste("Scenario",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))

    if(any(rownames(input$matrix1) == "")){
      tmpMat1 <- input$matrix1
      rownames(tmpMat1) <- paste("Row", seq_len(nrow(input$matrix1)))
      updateMatrixInput(session, inputId = "matrix1", value = tmpMat1)
      }
    updateMatrixInput(session, inputId = "matrix2", value = tmpMat2)
  })
  
  observeEvent(input$matrix2, {
    if(any(colnames(input$matrix2) == "")){
      tmpMat2 <- input$matrix2
      colnames(tmpMat2) <- paste("Scenario",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))
      updateMatrixInput(session, inputId = "matrix2", value = tmpMat2)
      }
    if(any(rownames(input$matrix2) == "")){
      tmpMat2 <- input$matrix2
      rownames(tmpMat2) <- paste("Row", seq_len(nrow(input$matrix2)))
      updateMatrixInput(session, inputId = "matrix2", value = tmpMat2)
      }
    input$matrix2
    # rv$tmpMat <- tmpMat2
  })
  # observe({print(rv$tmpMat)})
  
  plotData <- reactive({
    tryCatch(
      lapply(seq_len(ncol(input$matrix2)/2), 
             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(),
      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)

我在server 部分添加了以下代码位，其中添加的内容在每行末尾用“# added”标记。这些添加的代码在运行应用程序时显示了响应对象在 RStudio 控制台中作为用户输入是如何演变的。虽然输出视图不是很干净。如果我可以在从一个 observe() 移动到下一个时插入某种中断或文本标志，那就太好了。

server <- function(input, output, session){
  
  rv <- reactiveValues(tmpMat1=NULL,tmpMat2obsMat1=NULL,tmpMat2obsMat2=NULL) # Added
  
  observeEvent(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)
    colnames(tmpMat2) <- paste("Scenario",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))

    if(any(rownames(input$matrix1) == "")){
      tmpMat1 <- input$matrix1
      rownames(tmpMat1) <- paste("Row", seq_len(nrow(input$matrix1)))
      updateMatrixInput(session, inputId = "matrix1", value = tmpMat1)
      }
    updateMatrixInput(session, inputId = "matrix2", value = tmpMat2)
    
    rv$tmpMat1 <- input$matrix1 # Added
    rv$tmpMat2obsMat1 <- input$matrix2 # Added
  })
  
  observeEvent(input$matrix2, {
    if(any(colnames(input$matrix2) == "")){
      tmpMat2 <- input$matrix2
      colnames(tmpMat2) <- paste("Scenario",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))
      updateMatrixInput(session, inputId = "matrix2", value = tmpMat2)
      }
    if(any(rownames(input$matrix2) == "")){
      tmpMat2 <- input$matrix2
      rownames(tmpMat2) <- paste("Row", seq_len(nrow(input$matrix2)))
      updateMatrixInput(session, inputId = "matrix2", value = tmpMat2)
      }
    input$matrix2
    rv$tmpMat2obsMat2 <- input$matrix2 # Added 
  })
  
  observe({print(rv$tmpMat1)}) # Added
  observe({print(rv$tmpMat2obsMat1)}) # Added
  observe({print(rv$tmpMat2obsMat2)}) # Added
  
  plotData <- reactive({
    tryCatch(
      lapply(seq_len(ncol(input$matrix2)/2), 
             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(),
      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())
  })
}

Answer 1

请参阅添加到上述修订帖子的第二组代码中标有“#Added”的行。我还在底部的服务器部分添加了以下几行（上面未显示），以便为每个反应对象生成全局变量，以便在运行代码后查看结束值（有助于调试）：

oe1 <- reactive({
    rv$tmpMat1})
  observeEvent(oe1(),{tmpMat1.R <<- oe1()})
  
  oe2 <- reactive({
    rv$tmpMat2obsMat1})
  observeEvent(oe2(),{tmpMat2obsMat1.R <<- oe2()})
  
  oe3 <- reactive({
    rv$tmpMat2obsMat2})
  observeEvent(oe3(),{tmpMat2obsMat2.R <<- oe3()})