Saving editable tables at user's discretion to run functions and update other information

Hey all,
I am very experienced with R, but my Shiny experience is rather intermediate. I have a predictive model that I am wanting to user Shiny to gather information for some of the data. So, I am wanting to create a dashboard that allows user inputs into several tables. The updates to the tables need to be able to be saved to run the predictive model, but I don't want the model to run every time someone updates the input. Here is the generic code that I have used as a jumping off point.

### Libraries
library(shiny)
library(dplyr)
library(DT)

### Data
input_data <- data.frame(Brand = c("Brand1", "Brand2","Brand3"),
                         ratio = c (.5, .5, .5),
                         cost = c(2000, 3000, 4000),
                         stringsAsFactors = FALSE) %>% 
  mutate(updated_price = cost * ratio)




### Module
modFunction <- function(input, output, session, data,reset) {
  
  v <- reactiveValues(data = data)
  
  proxy = dataTableProxy("mod_table")
  
  observeEvent(input$mod_table_cell_edit, {
    print(names(v$data))
    info = input$mod_table_cell_edit
    str(info)
    i = info$row
    j = info$col
    k = info$value
    str(info)
    
    isolate(
      if (j %in% match(c("ratio","cost","updated_price"), names(v$data))) {
        print(match(c("ratio","cost", "updated_price"), names(v$data)))
        v$data[i, j] <<- DT::coerceValue(k, v$data[i, j])
        print(v$data)
        
        if (j %in% match("cost", names(v$data))) {
          v$data$updated_price <<- v$data$cost * v$data$ratio
        }
        if (j %in% match("ratio", names(v$data))) {
          v$data$updated_price <<- v$data$cost * v$data$ratio
        }
      } else {
        stop("You are not supposed to change this column.") # check to stop the user from editing only few columns
      }
    )
    replaceData(proxy, v$data, resetPaging = FALSE)  # replaces data displayed by the updated table
  })
  
  ### Reset Table
  observeEvent(reset(), {
    v$data <- data # your default data
  })
  
  print(isolate(colnames(v$data)))
  output$mod_table <- DT::renderDataTable({
    DT::datatable(v$data, editable = TRUE)
    
  })
}

modFunctionUI <- function(id) {
  ns <- NS(id)
  DT::dataTableOutput(ns("mod_table"))
  
}
ui <-  basicPage(
    mainPanel(
      
      actionButton("reset", "Reset"),
      tags$hr(),
       modFunctionUI("editable"), 
      modFunctionUI("editable1"), 
      modFunctionUI("editable2")
    )
  )
### Shiny App

  
  server <-  function(input, output) {
    demodata<-input_data
    callModule(modFunction,"editable", demodata,
               reset = reactive(input$reset))
    
    demodata1<-input_data
    callModule(modFunction,"editable1", demodata1,
               reset = reactive(input$reset))
    
    demodata2<-input_data
    callModule(modFunction,"editable2", demodata2,
               reset = reactive(input$reset))
  }
shinyApp(ui = ui,  server = server)

I am wanting to figure out:

  1. How do I reference these tables in functions outside of the table? The usual DT way was not working.
  2. How can I add a "save" button, so when its calling my much more intensive function, it doesn't try to run it in between every input change, but only when the user is done making inputs?

Thank you!

I hope this is useful for you.

### Libraries
library(shiny)
library(dplyr)
library(DT)

### Data
input_data <- data.frame(Brand = c("Brand1", "Brand2","Brand3"),
                         ratio = c (.5, .5, .5),
                         cost = c(2000, 3000, 4000),
                         stringsAsFactors = FALSE) %>% 
  mutate(updated_price = cost * ratio)




### Module
modFunction <- function(input, output, session, data,reset) {
  
  v <- reactiveValues(data = data)
  
  proxy = dataTableProxy("mod_table")
  
  observeEvent(input$mod_table_cell_edit, {
    print(names(v$data))
    info = input$mod_table_cell_edit
    str(info)
    i = info$row
    j = info$col
    k = info$value
    str(info)
    
    isolate(
      if (j %in% match(c("ratio","cost","updated_price"), names(v$data))) {
        print(match(c("ratio","cost", "updated_price"), names(v$data)))
        v$data[i, j] <<- DT::coerceValue(k, v$data[i, j])
        print(v$data)
        
        if (j %in% match("cost", names(v$data))) {
          v$data$updated_price <<- v$data$cost * v$data$ratio
        }
        if (j %in% match("ratio", names(v$data))) {
          v$data$updated_price <<- v$data$cost * v$data$ratio
        }
      } else {
        stop("You are not supposed to change this column.") # check to stop the user from editing only few columns
      }
    )
    replaceData(proxy, v$data, resetPaging = FALSE)  # replaces data displayed by the updated table
  })
  
  ### Reset Table
  observeEvent(reset(), {
    v$data <- data # your default data
  })
  
  print(isolate(colnames(v$data)))
  output$mod_table <- DT::renderDataTable({
    DT::datatable(v$data, editable = TRUE)
    
  })
  
  return(eventReactive(input$trigger,{
    v$data
  }))
}

modFunctionUI <- function(id) {
  ns <- NS(id)
  div(style="display:flex;width:40em;",
  DT::dataTableOutput(ns("mod_table")),
  actionButton(ns("trigger"),label = "send")
  )
}
ui <-  basicPage(
  mainPanel(
    
    actionButton("reset", "Reset"),
    tags$hr(),
  splitLayout(modFunctionUI("editable"),tableOutput("t_e0"),cellWidths = c("40em","40em")), 
  splitLayout(modFunctionUI("editable1"),tableOutput("t_e1"),cellWidths = c("40em","40em")), 
  splitLayout(modFunctionUI("editable2"),tableOutput("t_e2"),cellWidths = c("40em","40em"))
  )
)
### Shiny App


server <-  function(input, output) {
  demodata<-input_data
  e0 <- callModule(modFunction,"editable", demodata,
             reset = reactive(input$reset))
  
  demodata1<-input_data
  e1 <- callModule(modFunction,"editable1", demodata1,
             reset = reactive(input$reset))
  
  demodata2<-input_data
  e2 <- callModule(modFunction,"editable2", demodata2,
             reset = reactive(input$reset))
  
  output$t_e0 <- renderTable({req(e0())})
  output$t_e1 <- renderTable({req(e1())})
  output$t_e2 <- renderTable({req(e2())})
}
shinyApp(ui = ui,  server = server)
1 Like

Thank you, this was perfect! I made some edits for my own use, but this got me where I needed!

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.