R Shiny：向数据表添加新列

Question

我正在使用 R shiny 来创建机器学习应用程序。该应用程序使用输入小部件来创建测试观测值，然后将其馈送到随机森林模型并在单击操作按钮时输出估计值。

我想将选择的输入数据以及估计值和时间戳存储在数据表中。

我能够将所有选定的输入存储在一个表中，但是在将 2 个额外的列（估计和时间戳）添加到数据表中时遇到了一些问题。

有没有人有如何向数据表添加新列的示例？ 我正在使用renderDataTable() 和dataTableOutput() 函数来创建数据表。

这是我在网上找到的用于从输入小部件创建数据表的服务器函数的代码：

server <- function(input, output, session) {

# Create the Log 
  saveData <- function(data) {
    data <- as.data.frame(t(data))
    if (exists("inputparameters")) {
      inputparameters <<- rbind(inputparameters, data)
    } else {
      inputparameters <<- data
    }
  }
  loadData <- function() {
    if (exists("inputparameters")) {
      inputparameters
    }
  }
  
  # Whenever a field is filled, aggregate all form data
  formData <- reactive({
    data <- sapply(fields, function(x) input[[x]])
    data
  })
  
  # When the Submit button is clicked, save the form data
  observeEvent(input$submit, {
    saveData(formData())
  })
  
  # Show the previous responses
  # (update with current response when Submit is clicked)
  output$inputparameters <- DT::renderDataTable({
    input$submit
    loadData()
  })
  
} # End Server function

除了来自输入小部件的列之外，如何向表格添加新列？

在此先感谢您的所有意见。

Answer 1

这是我想出的解决方案：

library(shiny)
library(DT)

# datatable output function
dt_output = function(title, id) {
  fluidRow(column(
    12, h1(title)), # title
    hr(), DTOutput(id) # datatable output
  )
}
# render datatable function
render_dt = function(data, editable = 'cell', server = TRUE, ...) {
  renderDT(data, selection = 'none', server = server, editable = editable, ...)
}

# user interface
ui = fluidPage(
  
  # add button to add column
  actionButton(inputId = "addColumn", "New Column"),
  
  # custom column name
  textInput(inputId = "nameColumn", "New Column Name"),
  
  # title for page
  title = 'Double-click to edit table cells',
  # datatable output
  dt_output('Add Column Example")', 'x'),
  
  # add button to finish adding column and variables
  actionButton(inputId = "done", "Done"),
)


server <- function(input, output, session) {
  # use iris data as an reproducible example
  data = reactive({iris})
  
  # set up reactive value
  reactiveData = reactiveVal()
  
  # observe data
  observeEvent(data(),{
    reactiveData(data())
  })
  
  # showing only 5 rows per page
  options(DT.options = list(pageLength = 5))
  
  # make cells editable in our data
  output$x = render_dt(reactiveData(), 'cell')
  
  # edit a single cell
  proxy = dataTableProxy('x')
  observeEvent(input$x_cell_edit, {
    info = input$x_cell_edit
    newData <- reactiveData()
    newData[info$row, info$col] <- info$value
    reactiveData(newData)
    replaceData(proxy, reactiveData(), resetPaging = FALSE)
  })
  
  # add a column
  observeEvent(input$addColumn,{
    newData <- reactiveData()
    newData[[input$nameColumn]] <- numeric(length = nrow(newData))
    reactiveData(newData)
    replaceData(proxy, reactiveData(), resetPaging = FALSE)
    output$x = render_dt({
      reactiveData()
    })
  })
  
  # check for 'done' button press
  observeEvent(input$done, {
    stopApp(reactiveData())
  })
  
}

# run Shiny app
shinyApp(ui, server)

因为我无权访问您的数据，所以我提供了一个使用 iris 数据集的可重现示例。我使用这个DT-edit example 作为应用程序的基础。

正如@Stéphane Laurent 所说，有必要重新渲染表格（请参阅# add a column）。当前数据不会丢失，但您输入的第一个值会出现故障（它会重置值）。之后，第一个值将不再重置。我还提供了文本输入，以便可以命名新列。

按下“完成”按钮后，数据将输出到您的 R 控制台。

您可以反复按“添加列”按钮来生成列。