数据表不允许我编辑单元格，设置了 `editable = 'cell'`

Question

我正在开发一个生成 DT::datatable 的闪亮应用程序。预期流程是最终用户可以修改名为“支出”的字段之一，一旦他们添加自定义支出金额，就会根据新支出计算估计利润。

代码打击使用虚拟数据生成应用程序。当您运行应用程序并单击“dh”选项卡时，数据表会显示。我可以双击第二列（花费）中的任何单元格，但我不能“输入”它，按 Enter 什么也不做。

这是生成应用程序的代码：

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

# generates an example df based on inputed 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')
            
    )
  )
)


ui <- dashboardPage(header, sidebar, body)


# Server ----
server <- function(input, output) {
  
  # Initial budgets, eventually set to come from dropdowns or user input
  budgets <- list(
    '2020.4' = 1000000,
    '2021.1' = 1000000,
    '2021.2' = 1000000,
    '2021.3' = 1000000,
    '2021.4' = 1000000
  )
  
  budgets_df <- create_sample_df(budgets)
  
  # eventually use distinct budgets for each, just demo right now
  output$budgets_df_dh <- render_dt(data = budgets_df,
                                    rownames = FALSE,
                                    list(target = 'column',
                                         disable = list(columns = c(0, 2:4))))
  
  dh_proxy = DT::dataTableProxy('budgets_df_dh')
  
  observeEvent(input$budgets_df_dh_cell_edit, {
    
    info = input$budgets_df_dh_cell_edit
    str(info)
    i = info$row
    j = info$col
    v = info$value
    budgets[[i]] <<- v %>% as.numeric()
    budgets_df <<- create_sample_df(budgets)
    replaceData(dh_proxy, budgets_df, resetPaging = FALSE)
  })
  
}
shinyApp(ui, server)

我如何设置它以便用户可以修改 Spend 字段？

Answer 1

您需要将 j 偏移 1。另外，我创建了一个 reactiveValues 对象来显示更改已经生效，并且可以在服务器端进行进一步分析。它打印为您的表格下方的第二个表格。

# generates an example df based on inputed 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) {
  DF1 <- reactiveValues(data=NULL)
  # Initial budgets, eventually set to come from dropdowns or user input
  budgets <- list(
    '2020.4' = 1000000,
    '2021.1' = 1000000,
    '2021.2' = 1000000,
    '2021.3' = 1000000,
    '2021.4' = 1000000
  )

  budgets_df <- reactive({
    bud <- create_sample_df(budgets)
    DF1$data <- bud
    bud
  })

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

  #dh_proxy = DT::dataTableProxy('budgets_df_dh')

  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

    DF1$data[i,j] <<- DT::coerceValue(v , DF1$data[i, j]) 

  })
  output$tb1 <- renderDT(DF1$data)

}
shinyApp(ui, server)