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

Question

我正在为我昨天 post 的问题寻找解决方案，。帮助解决以下问题将帮助我找到昨天 post.

的可能解决方案

以下代码按预期工作。矩阵 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

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

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()})

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

How to show reactive matrix values in R studio console while running Shiny script?

r

shiny

shiny-reactivity