R Shiny 令人费解的警告 : Input to asJSON(keep_vec_names=TRUE) is a named vector

Question

我编写了一个 Shiny 的应用程序，它允许用户修改数据帧的各个行，但是当我尝试包含附加新行的选项时，我在控制台上收到此警告:

Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON.

并且在应包含数据框一列中的项目的文本输入框中，将显示以下内容:

[object Object]

这里有一些答案涉及警告消息，但条件与适用于我的情况不同，除了警告消息外，它们彼此之间似乎没有什么共同之处。

这是我用于修改数据框的应用程序。它完美地工作。

require(shiny)

in.df <- data.frame(name = c("Alice","Bob","Charles"), 
                age = c(22, 25, 36))
rownames(in.df) <- NULL
runApp(
  list(
    ui = fluidPage(
      sidebarPanel( 
        numericInput("line", "Line number", value = 1),
        textInput("name", "Name:"),
        numericInput("age", "Age:", value = 25),
        actionButton("amendButton", "Amend an entry") 
  ),
      mainPanel(
        tableOutput("table"))
    ),
    server = function(input, output, session){
      values <- reactiveValues()
      values$df <- in.df
      current_line <- reactive({
        il <- input$line
        nr <- nrow(values$df)
        if(il > nr){
          return(nr) 
        } else if(il <= 0){
          return(1) 
        } else{
          return(il) 
        } 
      })
      amendData <- observe({
        if(input$amendButton > 0){
          newLine <- isolate(c(input$name, input$age))
          values$df <- isolate(values$df[-  current_line(), ])
          isolate(values$df <-   rbind(as.matrix(values$df), unlist(newLine)))
          values$df <- values$df[order(values$df[,1]),]  
        }
      })

      observe({
        updateTextInput(session = session,
                        inputId = 'name', 
                        value =   values$df[unlist( current_line()),1]
        )
        updateNumericInput(session = session,
                           inputId = 'age', 
                           value = values$df[unlist( current_line()),2]
        )
        updateNumericInput(session = session ,
                           inputId = 'line', 
                           value =  current_line()
        )

      })
      output$table <- renderTable(values$df )
    }
  )
)

在我看来，通过以下方式添加“附加”选项是一件简单的事情:

添加新的操作按钮
actionButton("appendButton", "Append an entry")

包含一个相应的处理程序，它确实与 addButton 的处理程序非常相似。 :

addData <- observe({
     if(input$appendButton > 0){
       newLine <- isolate(c(input$name,    input$age)) 
       isolate(values$df <-  rbind(as.matrix(values$df), unlist(newLine)))
       values$df <- values$df[order(values$df[,1]),]
     }
   })

两个处理程序之间的唯一区别是新的处理程序不需要行

values$df <- isolate(values$df[-  current_line(), ])

因为在附加情况下没有删除旧行。

但它不起作用:我收到警告和我描述的文本输入框的奇怪变化。

Answer 1

在 Shiny 的 1.6 中，我更改后得到了一个正在运行的应用程序 amendData <- observe至 amendData <- observeEvent .否则代码会陷入无限循环。
但是，为了能够添加新行，我必须更改 react 值 current_line .该代码始终将其重置为现有行，以便永远不会添加新条目。
我改了current_line以便它也允许它是 nrow + 1并在 current_line 时清除数字输入字段大于行数。
现在，我终于看到了问题中描述的情况。
这是由 values$df <- rbind(as.matrix(values$df), unlist(newLine)) 引起的. R 添加了带有名称的新行。数据框的命名行在发送到 UI 时似乎是问题。我的猜测是，这是一个深埋在 Shiny 的响应式消息传递系统中的问题。

require(shiny)

in.df <- data.frame(name = c("Alice","Bob","Charles"), 
                    age = c(22L, 25L, 36L))
rownames(in.df) <- NULL

runApp(
  list(
    ui = fluidPage(
      sidebarPanel( 
        numericInput("line", "Line number", value = 1),
        textInput("name", "Name:"),
        numericInput("age", "Age:", value = 25),
        actionButton("amendButton", "Amend an entry") 
      ),
      mainPanel(
        tableOutput("table"))
    ),
    server = function(input, output, session){
      values <- reactiveValues()
      values$df <- in.df
      
      current_line <- reactive({
        il <- req(input$line)
        nr <- nrow(values$df)
        if(il > nr){
          return(nr+1)
        } else if (il <= 0){
          return(1) 
        } else {
          return(il) 
        } 
      })
      
      amendData <- observeEvent(input$amendButton, {
          isolate({
            newLine   <- c(input$name, as.numeric(input$age))
            values$df <- values$df[- current_line(), ]
            values$df <- rbind(values$df, unname(newLine))
          })
          values$df <- values$df[order(values$df[,1]),]
      })
      
      observe({
          updateNumericInput(session = session, inputId = 'line', 
                             value =  current_line())

        if (current_line() <= nrow(values$df)) {
          updateNumericInput(session = session, inputId = 'age', 
                             value = values$df[current_line(), 2])
          updateTextInput(session = session, inputId = 'name', 
                          value =   values$df[current_line(), 1])
        }
        else {
          updateNumericInput(session = session, inputId = 'age', value = "")
          updateNumericInput(session = session, inputId = 'name', value =  "")
        }
      })
        
      output$table <- renderTable( values$df )
    }
  )
)