Use an upated cell in a editable Shiny DT table to generate and redisplay the same underlying dataframe

The sample code block below generates a small Shiny app with a datatable.

The table shows spend, revenue and profit by quarter. The idea is that the user inputs spend amount and then the table updates with new data for revenue and profit. The new data is based on the imputed spend amount.

Here is the code to generate the app:

pacman::p_load(shiny, tidyverse, shinydashboard, lubridate, scales, DT)

# define some functions
# generates an example df based on imputed budgets
create_sample_df <- function(budgets) {
  data.frame(cohort = seq('2020-10-01' %>% ymd, '2021-12-31' %>% ymd, by = '1 days')) %>% 
    mutate(Quarter = quarter(cohort, with_year = T)) %>% 
    add_count(Quarter) %>% 
    mutate(DailyBudget = budgets[Quarter %>% as.character] %>% unlist / n) %>% 
    group_by(Quarter) %>% 
    mutate(Revenue = DailyBudget + rnorm(n(), mean = 0, sd = DailyBudget / 5)) %>% 
    summarise(Spend = sum(DailyBudget),
              Revenue = sum(Revenue),
              .groups = 'drop') %>% 
    mutate(Profit = dollar(Revenue - Spend),
           Payback = percent(Revenue / Spend),
           Spend = dollar(Spend),
           Revenue = dollar(Revenue)) %>% 
    mutate(Quarter = as.character(Quarter)) # do this last keep ordering of quarters
}


# render DT
render_dt = function(data, editable = 'cell', server = TRUE, ...) {
  renderDT(data, selection = 'none', server = server, editable = editable, ...)
}


# UI ----
header <- dashboardHeader(title = 'Velocity Spend & Return Calculator')
HTML("Adjust spend column for calculations")

sidebar <- dashboardSidebar(
  menuItem("dh", tabName = "dh", icon = icon("dashboard"))
)

body <- dashboardBody(
  tabItems(
    tabItem(tabName = "dh",
            h2("DH Estimator"),
            HTML("Adjust spend column for calculations"),
            DT::DTOutput('budgets_df_dh'),
            DTOutput("tb1")
            
    )
  )
)


ui <- dashboardPage(header, sidebar, body)


# Server ----
server <- function(input, output) {
  
  # Initial budgets, will update when a user edits the spend column in the app
  budgets <- list(
    '2020.4' = 1000000,
    '2021.1' = 1000000,
    '2021.2' = 1000000,
    '2021.3' = 1000000,
    '2021.4' = 1000000
  )
  
  # the df to be displayed as a DT::datatable. 
  budgets_df <- reactive({
    create_sample_df(budgets)
  })
  
  observeEvent(input$budgets_df_dh_cell_edit, {
    info = input$budgets_df_dh_cell_edit
    str(info)
    i = info$row
    j = info$col + 1
    v = info$value
    
    # update budgets, which in turn is used to generate data during create_sample_df()
    budgets[[i]] <<- v %>% str_replace_all('\\$|,', '') %>% as.numeric 
  })
  
  # eventually use distinct budgets for each, just demo right now
  output$budgets_df_dh <- render_dt(data = budgets_df(),
                                    rownames = FALSE,
                                    list(target = 'cell', 
                                         disable = list(columns = c(0, 2:4))))
  
}
shinyApp(ui, server)

When you run the app and click tab 'dh' it should look like this:

In the screen shot I have amended the spend in the first row from 1M to 2M. In my code Spend corresponds to the list called 'budgets' and I update it within observeEvent() above budgets[[i]] <<- v %>% str_replace_all('\\$|,', '') %>% as.numeric

After budgets list has been updated I would like to recreate budgets_df based on this new budget. You can see variable budgets being referred to within the function create_sample_df().

However, when I update the spend column in the app, the fields for Revenue and profit are unchanged. Expectation and desired result are that when the spend/budget is updated, the fields to the right are also updated.

pacman::p_load(shiny, tidyverse, shinydashboard, lubridate, scales, DT)

# define some functions
# generates an example df based on imputed budgets
create_sample_df <- function(budgets) {
  data.frame(cohort = seq('2020-10-01' %>% ymd, '2021-12-31' %>% ymd, by = '1 days')) %>% 
    mutate(Quarter = quarter(cohort, with_year = T)) %>% 
    add_count(Quarter) %>% 
    mutate(DailyBudget = budgets[Quarter %>% as.character] %>% unlist / n) %>% 
    group_by(Quarter) %>% 
    mutate(Revenue = DailyBudget + rnorm(n(), mean = 0, sd = DailyBudget / 5)) %>% 
    summarise(Spend = sum(DailyBudget),
              Revenue = sum(Revenue),
              .groups = 'drop') %>% 
    mutate(Profit = dollar(Revenue - Spend),
           Payback = percent(Revenue / Spend),
           Spend = dollar(Spend),
           Revenue = dollar(Revenue)) %>% 
    mutate(Quarter = as.character(Quarter)) # do this last keep ordering of quarters
}


 


# UI ----
header <- dashboardHeader(title = 'Velocity Spend & Return Calculator')
HTML("Adjust spend column for calculations")

sidebar <- dashboardSidebar(
  menuItem("dh", tabName = "dh", icon = icon("dashboard"))
)

body <- dashboardBody(
  tabItems(
    tabItem(tabName = "dh",
            h2("DH Estimator"),
            HTML("Adjust spend column for calculations"),
            DT::DTOutput('budgets_df_dh'),
            DTOutput("tb1")
            
    )
  )
)


ui <- dashboardPage(header, sidebar, body)


# Server ----
server <- function(input, output) {
  
  # Initial budgets, will update when a user edits the spend column in the app
  budgets <- reactiveVal(list(
    '2020.4' = 1000000,
    '2021.1' = 1000000,
    '2021.2' = 1000000,
    '2021.3' = 1000000,
    '2021.4' = 1000000
  ))
  
  # the df to be displayed as a DT::datatable. 
  budgets_df <- reactive({
    b<-req(budgets())
    print("budgets_df updated")
    create_sample_df(b)
  })
  
  budgets_df <- reactive({
    b<-req(budgets())
    print("budgets_df updated")
    create_sample_df(b)
  })
  observeEvent(input$budgets_df_dh_cell_edit, {
    info = input$budgets_df_dh_cell_edit
    str(info)
    i = info$row
    j = info$col + 1
    v = info$value
    
    # update budgets, which in turn is used to generate data during create_sample_df()
    btmp <- budgets()

    btmp[[i]] <- v %>% str_replace_all('\\$|,', '') %>% as.numeric 
    budgets(btmp)
  })
  

  
  # eventually use distinct budgets for each, just demo right now
  output$budgets_df_dh <-  renderDT(data=budgets_df(),
                                    selection = 'none', editable = 'cell', server = TRUE, rownames = FALSE,
                                    list(target = 'cell', 
                                         disable = list(columns = c(0, 2:4))))
  
 
  
}
shinyApp(ui, server)

This is really great! Thanks a lot I've been struggling with this. Looks like you made budgets a reactiveVal. Was that the silver bullet?

I delete the duplicate definition of budgets_df.

The code does work. I'm trying to understand it. I don't see budgets_df being redefined after a change. Is that because it's reactive and so any change to budgets will in turn auto update budgets_df?

In particular, what does this last line in observeEvent do? budgets(btmp). If budgets is a list that is a reactiveVal, are we saying, 'budgets is now btmp'? I guess that's what's happening here.

Yes exactly reactiveVals are set to new values with that syntax

Yes, also I think the render_dt pass thru function you'd made was losing the reactivity to i preferred to remove it rather than wrestle with it.

1 Like

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.