在 R Shiny 中，isTruthy() 函数没有按照我认为的方式工作答案

【问题标题】：In R Shiny, isTruthy() function is not working the way I think it should在 R Shiny 中，isTruthy() 函数没有按照我认为的方式工作
【发布时间】：2022-01-05 00:40:03
【问题描述】：

我相信我对 isTruthy() 函数的工作原理存在根本性的误解。

在下面的 MWE 中，对第一个矩阵的输入求和并绘制 10 个周期的直线。然而，这只有在矩阵 2 创建函数像在这个 MWE 中那样被注释掉时才有效。当矩阵 2 创建未注释时（矩阵 2 与矩阵 1 执行相同操作：对输入求和并绘制，但绘制为单独的线），矩阵 1 的输入不再求和并绘制。

问题似乎在于server 部分的plotData <- reactive({...} 函数下的if(isTruthy(input$matrix2)){...。我认为if(isTruthy(...) 在这种情况下意味着如果有手动输入到矩阵 2，然后绘制矩阵 2，否则跳到 else{...} 并仅绘制矩阵 1。（请注意，在较大的应用程序中，此代码源自，矩阵 2 在模态对话框中呈现，因此绘图被这样分解的原因。

我将如何更改此代码，以便仅在矩阵 2 中有手动输入时才绘制矩阵 2；否则绘制矩阵1？为了解决我遇到的一个更大的问题，即使存在矩阵 2，我也希望矩阵 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"),
      # matrixInput("matrix2",
      #             label = "Matrix 2 (Value Y applied in Period X):",
      #             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){
  
  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)
  })
  
  plotData <- reactive({
    tryCatch(
      if(isTruthy(input$matrix2)){
        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()
      } 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 有帮助吗？在用户为其输入任何值之前，input$matrix2 包含什么值？这个值是我提供的链接中列出的值之一吗？如果不是，则更改您的代码以测试“空”input$matrix2 rather than using isTruthy` 的值。
非常有帮助。我误解了 isTruthy() 的工作原理。最突出的点是：“......一个值是真实的，除非它是以下之一：FALSE，NULL，”，一个空原子向量，一个只包含缺失值的原子向量，一个包含所有 FALSE 或缺失值的逻辑向量, 类“try-error”的对象，表示未点击的 actionButton() 的值。所以我删除了 isTruthy()。但是，我在发布的原始代码中的错误因服务器部分中 plotData() 下有缺陷的 if/then/else 逻辑而更加复杂。现在我将发布的答案中的所有内容都已得到纠正。

标签： r shiny shiny-reactivity

【解决方案1】：

请参阅 CuriousJorge 对 Limey 评论的回复中的错误解释（isTruthy() 的使用不正确，plotData() 函数中的 if/then/else 逻辑有缺陷）。

请注意矩阵 1 如何将“下游”输入到矩阵 2 作为场景 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",
                  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){
  
  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
  })
  
  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)

【讨论】：