R 闪亮的令人费解的警告：asJSON(keep_vec_names=TRUE) 的输入是一个命名向量

Question

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

asJSON(keep_vec_names=TRUE) 的输入是一个命名向量。在 jsonlite 的未来版本中，将不再支持此选项，并且命名向量将被转换为数组而不是对象。如果您想要 JSON 对象输出，请改用命名列表。请参阅？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 )
    }
  )
)

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

1. 添加新的操作按钮

   actionButton("appendButton", "Append an entry")

2. 包含一个相应的处理程序，该处理程序实际上与以下处理程序非常相似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

在闪亮的 1.6 中，我在更改amendData <- observe为amendData <- observeEvent. 否则代码就会陷入无限循环。

但是，为了能够添加新行，我必须更改反应值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 )
    }
  )
)