在闪亮的应用程序中插入已编辑的数据表值

Question

我正在尝试了解如何使用已编辑数据中的值 table 并进行一些计算。

我有一个默认加载的数据框。当您单击 'run' 时，它会根据输入值更新 table。

我希望用户在 table 中手动编辑值，然后单击 'run'。接下来，我希望应用程序对数据 table、运行中的编辑值进行一些计算，并更新 table。通过这种方式，用户可以动态地看到他们的输入在 table.

上产生的结果

library(shiny)
library(DT)
library(dplyr)

#### Module 1 renders the first table
tableMod <- function(input, output, session, modelRun,modelData,budget){

  output$x1 <- DT::renderDataTable({
    modelRun()
    isolate(
      datatable(
        modelData %>% 
          mutate(New_Membership  = as.numeric(Modified * 0.01)*(budget())),
        selection = 'none', editable = TRUE
      )
    )
  })
  observeEvent(input$x1_cell_edit, {
    df[input$x1_cell_edit$row,input$x1_cell_edit$col] <<- input$x1_cell_edit$value
  })
}
tableUI <- function(id) {
  ns <- NS(id)
  dataTableOutput(ns("x1"))
}

ui <- function(request) {
  fluidPage(
    tableUI("opfun"),
    numericInput("budget_input", "Total Forecast", value = 2),
    actionButton("opt_run", "Run")
  )
}
server <- function(input, output, session) {

  df <- data.frame(Channel = c("A", "B","C"),
                   Current = c(2000, 3000, 4000),
                   Modified = c(2500, 3500,3000),
                   New_Membership = c(450, 650,700),
                   stringsAsFactors = FALSE)

  callModule( tableMod,"opfun",
              modelRun = reactive(input$opt_run),
              modelData = df,
              budget = reactive(input$budget_input))

  observeEvent(input$opt_run, {
    cat('HJE')
  })
}

shinyApp(ui, server, enableBookmarking = "url")

Answer 1

这应该有效，但 "cleanest" 实现无效：

我必须让 df 脱离 shiny 才能使您的代码正常工作。在编辑数据table 后，使用assign 替换全局环境中的df（不是最好的主意...）。但是，在按下 Run 之前不会重新计算数据。一旦按下 Run，modelData 就会被覆盖：(modelData <- df)。同样不是最好的主意，可能使 modelData 响应式会更好。

另外，看看DT::replaceData。这可能比重新生成完整的 table.

更好。

library(shiny)
library(DT)
library(dplyr)

df <- data.frame(Channel = c("A", "B","C"),
                 Current = c(2000, 3000, 4000),
                 Modified = c(2500, 3500,3000),
                 New_Membership = c(450, 650,700),
                 stringsAsFactors = FALSE)

#### Module 1 renders the first table
tableMod <- function(input, output, session, modelRun,modelData,budget){


  observeEvent( input$x1_cell_edit, {
    cat ('input$x1_cell_edit \n')
    info = input$x1_cell_edit
    str(info)
    i = info$row
    j = info$col
    v = info$value
    df[i, j] <- DT:::coerceValue(v, df[i, j])
    assign("df", df, envir = .GlobalEnv)

  })

  output$x1 <- DT::renderDataTable({
    modelRun()
    modelData <- df
    isolate(
      datatable(
        modelData %>% 
          mutate(New_Membership  = as.numeric(Modified * 0.01)*(budget())),
        selection = 'none', editable = TRUE
      )
    )
  })


}
tableUI <- function(id) {
  ns <- NS(id)
  dataTableOutput(ns("x1"))
}

ui <- function(request) {
  fluidPage(
    tableUI("opfun"),
    numericInput("budget_input", "Total Forecast", value = 2),
    actionButton("opt_run", "Run")
  )
}
server <- function(input, output, session) {

  callModule( tableMod,"opfun",
              modelRun = reactive(input$opt_run),
              modelData = df,
              budget = reactive(input$budget_input))

  observeEvent(input$opt_run, {
    cat('HJE')
  })
}

shinyApp(ui, server, enableBookmarking = "url")

Answer 2

一个干净的解决方案（而不是在其他环境中分配值）是在您的模块中使用与 datatable 同步的 reactiveVal。您可以从您的模块 return 这个 reactive 也可以在主应用程序中使用它：

library(shiny)
library(DT)
library(dplyr)

#### Module 1 renders the first table
tableMod <- function(input, output, session, modelRun, modelData, budget){

  df <- reactiveVal(modelData) ## this variable will be in sync with your datatable

  output$x1 <- DT::renderDataTable({
    modelRun()
    isolate(
      datatable(
        df() %>% ## ...you always use the synced version here
          mutate(New_Membership  = as.numeric(Modified * 0.01)*(budget())),
        selection = 'none', editable = TRUE
      )
    )
  })


  observeEvent(input$x1_cell_edit, { 
    new_df <- df()
    row <- input$x1_cell_edit$row
    col <- input$x1_cell_edit$col
    value <- as.numeric(input$x1_cell_edit$value)
    new_df[row, col] <- value
    df(new_df) ## ...and you make sure that 'df' stays in sync
  })

  list(updated_df = df) ## ...finally you return it to make use of it in the main app too
}
tableUI <- function(id) {
  ns <- NS(id)
  dataTableOutput(ns("x1"))
}

ui <- function(request) {
  fluidPage(
    tableUI("opfun"),
    numericInput("budget_input", "Total Forecast", value = 2),
    actionButton("opt_run", "Run")
  )
}
server <- function(input, output, session) {

  df <- data.frame(Channel = c("A", "B","C"),
                   Current = c(2000, 3000, 4000),
                   Modified = c(2500, 3500,3000),
                   New_Membership = c(450, 650,700),
                   stringsAsFactors = FALSE)

  result <- callModule( tableMod,"opfun",
              modelRun = reactive(input$opt_run),
              modelData = df,
              budget = reactive(input$budget_input))

  observeEvent(input$opt_run, {
    str(result$updated_df())
  })
}

shinyApp(ui, server, enableBookmarking = "url")

在闪亮的应用程序中插入已编辑的数据表值

Plugging edited Datatable values in a shiny app

r

shiny

dt

datatables-1.10