在 R Shiny 中，如何在观察事件中使用“isTruthy”？

Question

当运行下面的 MWE 代码时，用户可以选择输入到侧边栏面板中呈现的第一个矩阵和模式对话框中呈现的第二个矩阵。第二矩阵允许用户添加场景，以及修改默认情况下复制到第二矩阵左列的第一矩阵输入。

工作正常，除非用户没有触摸矩阵 1 并单击操作按钮来调用矩阵 2。在这种情况下，矩阵 2 应该拉起并反映矩阵 1 的默认值（6 个周期的值 5 )。相反，我在 R Studio 控制台中收到以下错误消息：“警告：matrixInput 中的错误：is.matrix(value) is not TRUE”。我尝试使用 MWE 模态对话框部分中突出显示的以下行来解决这个问题：

value = if(isTruthy(input$input2)){input$input2} 
                  else if(isTruthy(input$input1)){input$input1}
                  **else {matrix(c(6,5), 1, 2,**... 

但这不起作用。我还玩过req()、各种isTruthy 和is.null 迭代，但没有运气。我做错了什么？

MWE 代码：

library(shiny)
library(shinyMatrix)

curveFill <- function(x,y){ # Input correction, interpolation, extrapolation
  a <- y
  a[,1][a[,1]>x] <- x
  b <- diff(a[,1,drop=FALSE])
  b[b<=0] <- NA              
  b <- c(1,b)                                                       
  a <- cbind(a,b)
  a <- na.omit(a)
  a <- a[,-c(3),drop=FALSE] 
  c <- rep(NA, x)     
  c[a[,1]] <- a[,2]       
  c[seq_len(min(a[,1])-1)] <- c[min(a[,1])]   
  if(max(a[,1]) < x){c[seq(max(a[,1])+1, x, 1)] <- 0} 
  c <- approx(seq_along(c)[!is.na(c)],c[!is.na(c)],seq_along(c))$y  
  d <- seq(1:x)                                                   
  e <- data.frame(x=d,y=c)                                        
  return(e)}

ui <- fluidPage(
    sidebarLayout(
      sidebarPanel(uiOutput("panel"),actionButton("show2nd","Add curve scenario")),
      mainPanel(plotOutput("plot1"))
    )
  )

server <- function(input, output, session){
 
  rates <- function(){curveFill(input$periods,req(input$input1))}
  
  output$panel <- renderUI({
    tagList(
      sliderInput('periods','Periods (X):',min=2,max=12,value=6),
      uiOutput("input1"))
  })

  output$input1 <- renderUI({
    matrixInput("input1", 
                label = "Builder-curve scenario 1:",
                value = if(isTruthy(input$input2)){input$input2[,1:2]} else 
                          {matrix(c(input$periods,5), 1, 2, 
                                  dimnames = list(NULL,c("Period (X)","Y")))},
                rows =  list(extend = TRUE, names = FALSE),
                cols =  list(extend = FALSE, 
                             delta = 1,
                             delete = FALSE,
                             names = TRUE, 
                             editableNames = FALSE,
                             multiheader = FALSE),
                class = "numeric")
  })
  
  observeEvent(input$show2nd,{
    showModal(
      modalDialog(
        matrixInput("input2", 
          label = "Add builder-curves (sequentially numbered):",
          value = if(isTruthy(input$input2)){input$input2} 
                  else if(isTruthy(input$input1)){input$input1}
                  else {matrix(c(input$periods,5), 1, 2, 
                       dimnames = list(NULL,c("Period (X)","Y")))},
          rows =  list(extend = TRUE, names = FALSE),
          cols =  list(extend = TRUE, 
                       delta = 2,
                       delete = TRUE,
                       names = TRUE, 
                       editableNames = FALSE,
                       multiheader=TRUE
                       ),
          class = "numeric"),
    footer = modalButton("Close")
    ))
  })

  observe({
    req(input$input2)
    mm <- input$input2
    colnames(mm) <- trunc(1:ncol(mm)/2)+1 
    isolate(updateMatrixInput(session, "input2", mm))
  })
  
  output$plot1 <-renderPlot({
    req(rates())
    plot(rates())
  })
  
}

shinyApp(ui, server)

Answer 1

问题在于R 具有在子集时静默删除维度的讨厌属性，当维度之一等于1 时：

m <- matrix(1:4, 2, 2)
## works as expected b/c we are returning a 2 x 2 matrix
dim(m[, 1:2]) ## 2 2
## silently transforms to vector, arguably in this case maybe what we want
dim(m[1, 1:2]) ## NULL

## but here things get nasty
m2 <- matrix(1:2, 1, 2)
## here we would like to get a 1 x 2 matrix, instead we get a length 2 vector
dim(m2[, 1:2]) ## NULL

解决方案是使用drop = FALSE 来避免丢失尺寸。来自?`[`

drop：用于矩阵和数组。如果为“TRUE”，则结果被强制为 尽可能低的维度（参见示例）。

dim(m[1, 1:2, drop = FALSE]) ## 1 2
dim(m2[, 1:2, drop = FALSE]) ## 1 2

因此，在您的代码中，您应该使用 input$input2[, 1:2, drop = FALSE]（input$input1 也是如此）以确保您始终返回 matrix 而不是向量。

Answer 2

input$input2[,1:2] 不是矩阵，如果 input$input2 只有一行，它不是二维的，因此错误消息，我猜。使用rbind(input$input2[,1:2])或as.matrix(input$input2[,1:2])等。