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

Question

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

代码 blow 生成了带有虚拟数据的应用程序。当您运行应用程序并单击选项卡 'dh' 时，数据表会显示。我可以双击第二列中的任何单元格（花费），但我不能 'enter' 它，按 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)

如何设置才能让用户修改支出字段？

Answer 1

您需要 off-set j 1。另外，我创建了一个 reactiveValues 对象来表明更改已经生效，并且可以在服务器端进行进一步分析。它被打印为 table 下面的第二个 table。

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

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

Datatable not allowing me to edit cells, have setting `editable = 'cell'`

r

shiny

dt