在 R Shiny App 中,如何在首次调用应用程序时呈现默认值 table?

In R Shiny App, how to render a default table when first invoking the App?

下面的 MWE 代码工作正常,除了第一次调用应用程序时,默认的 table 没有按应有的方式呈现在侧边栏面板中。

默认 table 仅在单击该侧边栏面板中的“修改”操作按钮后呈现。在单击“修改”操作按钮之前,我在边栏面板中收到以下错误消息:“is.matrix(value) is not TRUE”。

那么如何让默认 table 在调用应用程序时正确呈现?

请注意,单击“修改”操作按钮并对模态对话框中弹出的矩阵输入网格进行任何更改后,这些更改会立即反映在边栏中出现的 table 中面板,当用户关闭模态对话框并再次单击“修改”时,这些更改会“保留”。这是一个运行良好的重要功能。

是的,我 post 在 8 月 24 日针对更复杂的代码部分提出了一个类似的问题,但我在将其实施到该示例中时遇到了问题。我尝试通过以下方式实施此解决方案:

df <- if(is.null(input$modify)){df >- NULL}
          else{input$matrix3}

在下面的 MWE 代码中,以及其他地方,包括内部 reactiveValues,但还没有成功。希望如果有人再次指导我完成此解决方案,它会“坚持”我!

弄清楚这一点后,我将 post 更正后的代码询问究竟是什么在反应链中允许通过单击“修改”操作按钮来修改矩阵输入网格通过到下一次点击。我正在尝试在另一段代码中重复此功能。

MWE 代码:

library(shiny)
library(shinyMatrix)
library(shinyjs)

# Function assigns row headers to input matrix grid
  matrix3Headers <- function(){c('A','B','C','D')}

# Assigns default values to first column of input matrix grid
  matrix3Default <- matrix(c(1,24,0,100),4,1,dimnames=list(matrix3Headers(),NULL))

# Automatically assigns names to column headers
  colnames(matrix3Default) <- paste0("Series ",1:ncol(matrix3Default))

# Matrix input function
  matrix3Input <- function(x, matrix3Default){
    matrixInput(x,
                label =  'Input series terms into below grid:',
                value =  matrix3Default, 
                rows  =  list(extend=FALSE,names=TRUE), 
                cols  =  list(extend=TRUE,names=TRUE,editableNames=FALSE,delete=TRUE),
                class =  'numeric'
      ) # close matrix input
  } # close function

ui <- fluidPage(
    useShinyjs(),
    titlePanel('Inputs'),
    fluidRow(actionButton('modify','Modify'),tableOutput('table2'))
  ) # close fluid page

server <- function(input, output, session){
  
  rv <- reactiveValues(
          mat3=matrix3Input('matrix3',matrix3Default),
          input=matrix3Default,
          colHeader = colnames(input)
        ) # close reactive values
  
  observeEvent(input$modify,{
    showModal(modalDialog(
      rv$mat3,
    )) # close shown modal and modal dialog
  }) # close observe event
  
  output$table2 <- renderTable({
    rv$mat3 <- matrix3Input('matrix3',input$matrix3)
    
    df <- if(is.null(input$modify)){df >- NULL}
          else{input$matrix3}
    
    n <- dim(df)[2]
    rownames(df) <- matrix3Headers()
    
    rv$input <- df
    colnames(df) <- paste("Series", 1:n)
    df},rownames=TRUE, colnames=TRUE) # close output$table1
  
  } # close server

shinyApp(ui, server)

您在测试 input$modify 是否存在之前调用 matrix3Input(),因此您收到错误 is.matrix(value) is not TRUE,因为 input$matrix3 尚不存在。

如果您在调用 matrix3Input() 函数之前移动您的测试,您的 is.null(input$modify) 始终是 FALSE,您必须使用 isTruthy() 函数来测试 Shiny 中的输入。使用 print() 函数检查您正在测试的值,例如print(is.null(input$modify).

这是一个工作示例:

  output$table2 <- renderTable({
    
    if(!isTruthy(input$modify)){df <- matrix3Default}
    else{
    req(input$matrix3)
    rv$mat3 <- matrix3Input('matrix3',input$matrix3)
    df <- input$matrix3
    n <- dim(df)[2]
    rownames(df) <- matrix3Headers()
    
    rv$input <- df
    colnames(df) <- paste("Series", 1:n)
    
    }
    df
    },rownames=TRUE, colnames=TRUE) # close output$table2

这个例子显示了从 matrix3Default 中获取默认值的矩阵(如您在标题中所问),如果您不想初始显示,只需将 df <- matrix3Default 替换为 df <- NULL table.

您可以检查 renderTable 中的 NULL 值,以便代码仅在存在 input$matrix3 时运行。除此之外,您可以进一步简化逻辑,以便代码仅在 !is.null(input$modify)

时运行
matrix3Headers <- function(){c('A','B','C','D')}

# Assigns default values to first column of input matrix grid
matrix3Default <- matrix(c(1,24,0,100),4,1,dimnames=list(matrix3Headers(),NULL))

# Automatically assigns names to column headers
colnames(matrix3Default) <- paste0("Series ",1:ncol(matrix3Default))

# Matrix input function
matrix3Input <- function(x, matrix3Default){
  matrixInput(x,
              label =  'Input series terms into below grid:',
              value =  matrix3Default, 
              rows  =  list(extend=FALSE,names=TRUE), 
              cols  =  list(extend=TRUE,names=TRUE,editableNames=FALSE,delete=TRUE),
              class =  'numeric'
  ) # close matrix input
} # close function

ui <- fluidPage(
  useShinyjs(),
  titlePanel('Inputs'),
  fluidRow(actionButton('modify','Modify'),
           tableOutput('table2'))
) # close fluid page

server <- function(input, output, session){
  
  rv <- reactiveValues(
    mat3=matrix3Input('matrix3',matrix3Default),
    input=matrix3Default,
    colHeader = colnames(input)
  ) # close reactive values
  
  observeEvent(input$modify,{
    showModal(modalDialog(
      rv$mat3
    )) # close shown modal and modal dialog
  }) # close observe event
  
  output$table2 <- renderTable({
    if(is.null(input$matrix3)) return(matrix3Default)
    rv$mat3 <- matrix3Input('matrix3',input$matrix3)
    
    df <- input$matrix3
    if(!is.null(input$modify)) {
      n <- dim(df)[2]
      rownames(df) <- matrix3Headers()
      
      rv$input <- df
      colnames(df) <- paste("Series", 1:n)
    }
    df
  }, colnames=TRUE) # close output$table1
  
} # close server

shinyApp(ui, server)

PS - >- 不是 R 中的有效运算符。