R Shiny：如何更改存储的数据？

I wrote a shiny app for sports betting which enables me to

我为体育博彩写了一个闪亮的应用程序,这使我能够

run a model and pick a winner,

运行模型并挑选一名获胜者,

add additional variables if I decide to bet on a game and store this in a database, and

如果我决定下注游戏并将其存储在数据库中,则添加其他变量

track my betting performance and adapt strategies using this information.

跟踪我的投注表现并使用此信息调整策略。

The app works fine so far, but has one major flaw: when I made the calculations and decide to bet on a game, I can simply add another row into a database by using a submit button. The problem is that I have two important columns for data analysis, which can only be added after the game. Thus, I would need to add or change information in a row I submitted before the game.

该应用程序到目前为止工作正常,但有一个主要缺陷:当我进行计算并决定下注游戏时,我可以使用提交按钮将另一行添加到数据库中。问题是我有两个重要的数据分析列,只能在游戏后添加。因此,我需要在游戏前提交的行中添加或更改信息。

I built the data storage part of my app on this input of Dean Attali, so I use also the minimum example from this tutorial (thanks @Dean by the way). It is the basic app without storage, but I guess the important thing is to get back to already existing rows and change (or expand) them. Has anyone done something similar already or has an idea how this could be solved?

我在Dean Attali的这个输入上构建了我的应用程序的数据存储部分,所以我也使用了本教程中的最小示例(顺便感谢@Dean)。它是没有存储空间的基本应用程序,但我想重要的是回到已经存在的行并更改(或扩展)它们。有没有人做过类似的事情,或者知道如何解决这个问题?

UPDATE: I found a solution for my problem here enter link description here (on the bottom - March 15th). I tried to implement it, but there is no reaction in the tables, since I obviously miss an important point. Does anyone has an idea how to make the table responding?

更新:我在这里找到了解决问题的方法在这里输入链接描述(在底部 - 3月15日)。我试图实现它,但表中没有反应,因为我显然错过了一个重点。有没有人知道如何使表格响应?

library(shiny)
library(DT)
devtools::install_github('rstudio/DT@feature/editor')

saveData <- function(data) {
  data <- as.data.frame(t(data))
  if (exists("responses")) {
    responses <<- rbind(responses, data)
  } else {
    responses <<- data
  }
}

loadData <- function() {
  if (exists("responses")) {
    responses
  }
}

# Define the fields we want to save from the form
fields <- c("name", "used_shiny", "r_num_years")

# Shiny app with 3 fields that the user can submit data for
shinyApp(
  ui = fluidPage(
    DT::dataTableOutput("responses", width = 300), tags$hr(),
    textInput("name", "Name", ""),
    checkboxInput("used_shiny", "I've built a Shiny app in R before", FALSE),
    sliderInput("r_num_years", "Number of years using R",
            0, 25, 2, ticks = FALSE),
    actionButton("submit", "Submit")
  ),
  server = function(input, output, session) {

# 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$responses <- DT::renderDataTable({
  input$submit
  loadData() %>%
    datatable(rownames = FALSE)
    })

  proxy <- dataTableProxy("x1")

  observeEvent(input$x1_cell_edit, {
  info <- input$x1_cell_edit
  i <- info$row
  j <- info$col + 1
  v <- info$value
  loadData[i, j] <<- DT:::coerceValue(v, loadData[i, j])
  replaceData(proxy, loadData, resetPaging = FALSE, rownames = FALSE)
})     
  }
)

1 个解决方案

#1

I fixed up a few issues in the updated example that uses the DT live editor:

我修复了使用DT实时编辑器的更新示例中的一些问题:

Added getDataValue and setDataValue functions to read/manipulate single entries in the data frame

添加了getDataValue和setDataValue函数来读取/操作数据框中的单个条目

Replaced the instances of x1 (name of table from the example code on GitHub) with responses

用响应替换了x1(GitHub上的示例代码中的表名)的实例

Added simplify = FALSE to the sapply so it returns a list instead of a vector. This is so data added to the table can be of different types. Vectors in R only have one type, so all the table data was being converted to strings, even TRUE/FALSE

为了sapply添加了simplify = FALSE,因此它返回一个列表而不是一个向量。这样,添加到表中的数据可以是不同类型的。 R中的向量只有一种类型,因此所有表数据都被转换为字符串,甚至是TRUE / FALSE

# devtools::install_github('rstudio/DT@feature/editor')
library(shiny)
library(DT)

saveData <- function(data) {
  if (exists("responses")) {
    responses <<- rbind(responses, data)
  } else {
    responses <<- data.frame(data, stringsAsFactors = FALSE)
  }
}

loadData <- function() {
  if (exists("responses")) {
    responses
  }
}

getDataValue <- function(i, j) {
  stopifnot(exists("responses"))
  responses[i, j]
}

setDataValue <- function(i, j, value) {
  stopifnot(exists("responses"))
  responses[i, j] <<- value
  responses
}

# Define the fields we want to save from the form
fields <- c("name", "used_shiny", "r_num_years")

# Shiny app with 3 fields that the user can submit data for
shinyApp(
  ui = fluidPage(
    DT::dataTableOutput("responses", width = 300), tags$hr(),
    textInput("name", "Name", ""),
    checkboxInput("used_shiny", "I've built a Shiny app in R before", FALSE),
    sliderInput("r_num_years", "Number of years using R",
                0, 25, 2, ticks = FALSE),
    actionButton("submit", "Submit")
  ),
  server = function(input, output, session) {

    # Whenever a field is filled, aggregate all form data
    formData <- reactive({
      data <- sapply(fields, function(x) input[[x]], simplify = FALSE)
      data
    })

    # Show the previous responses
    # (update with current response when Submit is clicked)
    output$responses <- DT::renderDataTable({
      req(input$submit)
      newData <- isolate(formData())
      saveData(newData)
      datatable(loadData(), rownames = FALSE)
    })

    proxy <- dataTableProxy("responses")

    observeEvent(input$responses_cell_edit, {
      info <- input$responses_cell_edit
      i <- info$row
      j <- info$col + 1
      v <- info$value

      newValue <- DT:::coerceValue(v, getDataValue(i, j))
      setDataValue(i, j, newValue)
      DT::replaceData(proxy, loadData(), resetPaging = FALSE, rownames = FALSE)
    })
  }
)

#1