huan
huan

Reputation: 308

R Shiny: how to change stored data?

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

  1. run a model and pick a winner,
  2. add additional variables if I decide to bet on a game and store this in a database, and
  3. 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?

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?

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)
})     
  }
)

Upvotes: 0

Views: 1914

Answers (1)

greg L
greg L

Reputation: 4124

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

  • Added getDataValue and setDataValue functions to read/manipulate single entries in the data frame
  • Replaced the instances of x1 (name of table from the example code on GitHub) with responses
  • 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
# 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)
    })
  }
)

Upvotes: 3

Related Questions